代码运行时错误：'424'，要求对象

sxdajun 2023-11-18 15:47:01

Sub D_调拨清空()
Application.ScreenUpdating = False
With ActiveSheet
.Range("C3") = ""
.Range("C4") = ""

.Range("B7:I56").ClearContents

.Range("C60") = ""

.Range("N1") = Format(Now(), "yyyy-m-d")
.Range("H3") = "=text(N1,""yyyy-m-d"")"

.Range("H2") = "=" & Sheet13.Name & "!$C$18&" & Sheet13.Name & "!$C$21&TEXT(N1," & Sheet13.Name & "!$C$19)&" & Sheet13.Name & "!$C$21&TEXT(N2," & Sheet13.Name & "!$C$20)"

.Range("X1") = ""
.Range("Z1") = ""

.Range("H57") = "=Sum(H6:H55)"
.Range("C57") = "=""人民币(大写) ""&N2RMB(H57)"
.Range("H7:H56").FormulaR1C1 = "=RC[-2]*RC[-1]"
End With
Call ShowLine
Application.ScreenUpdating = True
End Sub

Sub D_调拨保存()

'a = Range("C3") '供应商
b = Format(Range("H3"), "yyyy-m-d") '日期
tembh = Range("H2") '单号

d1 = Application.WorksheetFunction.CountA(Range("B7:B56")) '产品数据行数
d2 = Application.WorksheetFunction.CountA(Range("F7:F56")) '产品数量行

'If a = "" Then
'MsgBox "请输入供货商及相关信息!", 64, "保存提示"
'Exit Sub
'End If

If b = "" Then
MsgBox "请输入购买日期!", 64, "保存提示"
Exit Sub
End If

If tembh = "" Then
MsgBox "请输入单号!", 64, "保存提示"
Exit Sub
End If

'******************************************************************************
Dim k, n, o As Long
n = Sheet4.Range("A" & Sheet4.Rows.Count).End(xlUp).Row
Dim brr
brr = Sheet4.Range("B1:D" & n)
For o = 1 To n
If tembh = UCase(Trim(CStr(brr(o, 3)))) And CStr(brr(o, 1)) = "调库" Then
Dim ms
ms = MsgBox("已经存在 " & Trim(CStr(Range("H2").Value)) & " 的单据号码，是否覆盖以前的数据？" & vbCrLf & vbCrLf & "点击“是”覆盖以前的数据；点击“否”取消本次保存操作。", vbYesNo + vbInformation, "提示")
If ms = vbNo Then
Exit Sub
Else
Call TiaoKuDan_DelRs(False)
Exit For
End If

End If
Next

If d1 = d2 And d1 = 0 And d2 = 0 Then
MsgBox "没有数据可以保存,请输入数据后再点击保存数据！", 64, "保存提示"
Exit Sub
End If

If d1 <> d2 Then
MsgBox "请检查商品名称及数量是否已对应输入,请输入或清除多余数据后保存!", 64, "保存提示"
Exit Sub
End If

If Range("I61") = "" Then
MsgBox "您没有选择制单人！为了方便查询，请选择输入制单人！", 64, "提示"
Exit Sub
End If

Dim arr()
xi = Sheet2.Range("A" & Sheet2.Rows.Count).End(xlUp).Row
ReDim arr(1 To xi)
For xxj = 1 To xi
arr(xxj) = Sheet2.Range("A" & xxj)
Next

s = 0
For j = 7 To 56
If Range("B" & j) <> "" Then
For j1 = 1 To UBound(arr)
If Range("B" & j) = arr(j1) Then
s = 1
Exit For
End If
Next
If s = 0 Then

MsgBox "行号：" & j & " 编码：" & Range("B" & j) & " 名称：" & Range("D" & j) & "记录非窗体选择，请双击录入", vbInformation, "消息提示"
Exit Sub


ElseIf s > 0 Then


End If

s = 0

End If
Next

Application.ScreenUpdating = False

If Sheet4.AutoFilterMode = True Then Sheet4.Range("A1").AutoFilter

With ActiveSheet

For i = 7 To 56
If .Range("B" & i) <> "" Then
f1 = Sheet4.Range("B" & Rows.Count).End(xlUp).Row + 1

Sheet4.Range("A" & f1) = "=row()-1" '行号
Sheet4.Range("B" & f1) = "调库" '单据类型"
Sheet4.Range("C" & f1) = Format(b, "yyyy-m-d") '日期
Sheet4.Range("D" & f1) = "'" & tembh '单号
'Sheet4.Range("E" & f1) = "'" & .Range("X1") '单位编号
'Sheet4.Range("F" & f1) = "'" & a '往来单位
'Sheet4.Range("G" & f1) = "'" & .Range("C4") '地址
'Sheet4.Range("H" & f1) = "'" & .Range("E4") '电话
'Sheet4.Range("I" & f1) = "'" & .Range("E3") '联系人
Sheet4.Range("J" & f1) = "'" & .Range("C4") '仓库

Sheet4.Range("S" & f1) = "'" & .Range("C60") '总备注
Sheet4.Range("T" & f1) = "'" & .Range("I61") '制单人

Sheet4.Range("K" & f1) = "'" & .Range("B" & i) '商品编号
Sheet4.Range("L" & f1) = "'" & .Range("C" & i) '名称
Sheet4.Range("M" & f1) = "'" & .Range("D" & i) '规格
Sheet4.Range("N" & f1) = "'" & .Range("E" & i) '单位
Sheet4.Range("O" & f1) = .Range("F" & i) '单价
Sheet4.Range("P" & f1) = .Range("G" & i) '数量
Sheet4.Range("Q" & f1) = .Range("H" & i) '金额
Sheet4.Range("R" & f1) = .Range("I" & i) '备注
'*************************************************
f1 = Sheet4.Range("B" & Rows.Count).End(xlUp).Row + 1

Sheet4.Range("S" & f1) = "'" & .Range("C60") '总备注
Sheet4.Range("T" & f1) = "'" & .Range("I61") '制单人

Sheet4.Range("K" & f1) = "'" & .Range("B" & i) '商品编号
Sheet4.Range("L" & f1) = "'" & .Range("C" & i) '名称
Sheet4.Range("M" & f1) = "'" & .Range("D" & i) '规格
Sheet4.Range("N" & f1) = "'" & .Range("E" & i) '单位
Sheet4.Range("O" & f1) = .Range("F" & i) * -1 '数量
Sheet4.Range("P" & f1) = .Range("G" & i) '单价
Sheet4.Range("Q" & f1) = .Range("H" & i) * -1 '金额
Sheet4.Range("R" & f1) = .Range("I" & i) '备注

End If
Next

If .Range("Z1") <> "A" Then
h = Range("N2").Value
Range("N2").Value = h + 1
End If

Call D_调拨清空

End With

Range("A1").Select
Application.ScreenUpdating = True

End Sub

根据这个表单，运行代码时，以下红色地方提示：运行时错误：'424'

要求对象

哪位大佬看一下这个问题出在哪里？
Sub D_调拨查询()
调库查询.Show

End Sub

Sub D_调拨删除()
Application.ScreenUpdating = False

If Trim(Range("H2").Value) = "" Then
MsgBox "单据号不能为空！", 48, "系统提示"
Range("H2").Select
Exit Sub
End If

Dim ms
ms = MsgBox("您确定要删除单据 " & CStr(Range("H2").Value) & " 的所有数据吗？" & vbCrLf & vbCrLf & "点击“是”将删除单据所有记录；" & vbCrLf & vbCrLf & "点击“否”将取消本次删除操作。", vbYesNo + vbInformation, "提示")
If ms = vbNo Then
Application.ScreenUpdating = True
Exit Sub
End If

Call TiaoKuDan_DelRs(True)

Call D_调拨清空

Range("A2").Select

Application.ScreenUpdating = True
End Sub
Private Sub TiaoKuDan_DelRs(TiShi As Boolean)
Dim bomlist
Dim rng As Range
Dim tembh As String

bomlist = Sheet4.Range("A1:T" & Sheet4.Range("A" & Sheet4.Rows.Count).End(xlUp).Row)

tembh = CStr(Range("H2").Value)

Dim i, j As Long

For i = 1 To UBound(bomlist, 1)
If UBound(bomlist, 1) < 2 Then Exit For

If (CStr(bomlist(i, 4)) = tembh) And bomlist(i, 2) = "调库" Then
If rng Is Nothing Then
Set rng = Sheet4.Range(i & ":" & i)
Else
Set rng = Union(rng, Sheet4.Range(i & ":" & i))
End If
End If
Next i

If Not (rng Is Nothing) Then
rng.Delete xlUp
If TiShi = True Then
MsgBox "您指定的调库单 " & tembh & " 删除成功！", 64, "系统提示"
End If
Else
If TiShi = True Then
MsgBox "您指定的调库单号 " & tembh & " 不存在！", 48, "系统提示"
End If
End If
Set rng = Nothing
End Sub

Sub D_调拨单打印()

ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True

End Sub

...全文