无处不在：应用程序定义或对象定义的错误

Question

我写了一个小宏，将交易输入我们的 ERP 系统，当它确定电子表格中定义的第二个位置是否大于零时，事情似乎变得一团糟。这是我的代码：

    Option Explicit

Sub DblChk()

If (MsgBox("Are you sure you are ready to append scrap data to QAD? This cannot be reversed.", vbOKCancel)) = 1 Then

Call Scrap

Else: Exit Sub

End If

End Sub

Sub Scrap()

On Error GoTo ErrorHelper

Sheets("Roundup").Select

Range("I2").Select

Call Shell("C:\Program Files\QAD\QAD Enterprise Applications 2.9.6\QAD.Applications.exe", vbNormalFocus)

'Sign in to QAD
Application.Wait (Now + TimeValue("0:00:05"))
SendKeys ("username")
SendKeys ("{TAB}")
SendKeys ("password")
SendKeys ("{ENTER}")

'Enter Scrap

Application.Wait (Now + TimeValue("0:00:15"))
SendKeys ("{TAB}")
Application.Wait (Now + TimeValue("0:00:01"))
SendKeys ("{TAB}")
Application.Wait (Now + TimeValue("0:00:01"))

'Scrap Loop

Do While Not IsEmpty(ActiveCell)

If ActiveCell.Value > 0 Then

ActiveCell.Offset(0, -8).Activate
SendKeys (ActiveCell.Value)
ActiveCell.Offset(0, 6).Activate
SendKeys ("{ENTER}")
SendKeys (ActiveCell.Value)
SendKeys ("{TAB}")
SendKeys ("{TAB}")
SendKeys ("{TAB}")
Application.Wait (Now + TimeValue("0:00:01"))
ActiveCell.Offset(0, -1).Activate
SendKeys (ActiveCell.Value)
SendKeys ("{ENTER}")
SendKeys ("{TAB}")
SendKeys ("{TAB}")
Application.Wait (Now + TimeValue("0:00:01"))
SendKeys ("SCRAP")
SendKeys ("{TAB}")
SendKeys ("{TAB}")
SendKeys ("{TAB}")
SendKeys ("{TAB}")
Application.Wait (Now + TimeValue("0:00:01"))
ActiveCell.Offset(0, 2).Activate
SendKeys (ActiveCell.Value)
SendKeys ("{TAB}")
ActiveCell.Offset(0, -4).Activate
SendKeys (ActiveCell.Value)
SendKeys ("{TAB}")
ActiveCell.Offset(0, 1).Activate
SendKeys (ActiveCell.Value)
SendKeys ("{ENTER}")
SendKeys ("{ENTER}")
ActiveCell.Offset(1, -4).Activate

Else

ActiveCell.Offset(1, 0).Activate

End If

Loop
ErrorHelper:
MsgBox Err.Description
End Sub

我在 Internet 上看到过多次提到此错误，但 none 似乎适用于我的具体情况。 If 语句的开头似乎出错了。

有什么想法吗？

Answer 1

我对你的代码做了一些调整（查看代码中的注释）

Sub DblChk()
    Rem This line is enough anything else is redundant
    If MsgBox("Are you sure you are ready to append scrap data to QAD? This cannot be reversed.", vbOKCancel) = 1 Then Call Scrap
End Sub

这是您修改后的代码，注意声明变量的使用，它仍然显示原始行"commented"

一般假设 Offset 命令总是引用此行中的 ActiveCell：

Do While Not IsEmpty(ActiveCell) 用这个代替 Do While rCll.Value2 <> Empty

注意在ErrorHelper行之前添加Exit Sub行，否则即使没有错误也会一直显示错误信息。

Sub Scrap()
Dim rCll As Range
On Error GoTo ErrorHelper

''    Sheets("Roundup").Select
''    Range("I2").Select
    Set rCll = ThisWorkbook.Sheets("Roundup").Range("I2") 'If Procedure resides is Workbook with data
    'Set rCll = Workbooks(WbkName).Sheets("Roundup").Range("I2") 'If Procedure does not reside is Workbook with data

    Call Shell("C:\Program Files\QAD\QAD Enterprise Applications 2.9.6\QAD.Applications.exe", vbNormalFocus)

    'Sign in to QAD
    Application.Wait (Now + TimeValue("0:00:05"))
        SendKeys ("username")
        SendKeys ("{TAB}")
        SendKeys ("password")
        SendKeys ("{ENTER}")

    'Enter Scrap
    Application.Wait (Now + TimeValue("0:00:15"))
        SendKeys ("{TAB}")
    Application.Wait (Now + TimeValue("0:00:01"))
        SendKeys ("{TAB}")
    Application.Wait (Now + TimeValue("0:00:01"))

    'Scrap Loop
'    Do While Not IsEmpty(ActiveCell)
    Do While rCll.Value2 <> Empty
    Rem ActiveCell.Value2=empty is more accurate than IsEmpty(ActiveCell)
        With rCll

            If .Value2 > 0 Then

'                ActiveCell.Offset(0, -8).Activate
'                    SendKeys (ActiveCell.Value)
                SendKeys (.Offset(0, -8).Value2)

'                ActiveCell.Offset(0, 6).Activate
                SendKeys ("{ENTER}")
'                SendKeys (ActiveCell.Value)
                SendKeys (.Offset(0, 6).Value2)
                SendKeys ("{TAB}")
                SendKeys ("{TAB}")
                SendKeys ("{TAB}")

                Application.Wait (Now + TimeValue("0:00:01"))
'                ActiveCell.Offset(0, -1).Activate
'                SendKeys (ActiveCell.Value)
                SendKeys (.Offset(0, -1).Value2)
                SendKeys ("{ENTER}")
                SendKeys ("{TAB}")
                SendKeys ("{TAB}")

                Application.Wait (Now + TimeValue("0:00:01"))
                SendKeys ("SCRAP")
                SendKeys ("{TAB}")
                SendKeys ("{TAB}")
                SendKeys ("{TAB}")
                SendKeys ("{TAB}")

                Application.Wait (Now + TimeValue("0:00:01"))
'                ActiveCell.Offset(0, 2).Activate
'                SendKeys (ActiveCell.Value)
                SendKeys (.Offset(0, 2).Value2)
                SendKeys ("{TAB}")

'                ActiveCell.Offset(0, -4).Activate
'                SendKeys (ActiveCell.Value)
                SendKeys (.Offset(0, -4).Value2)
                SendKeys ("{TAB}")

'                ActiveCell.Offset(0, 1).Activate
'                SendKeys (ActiveCell.Value)
                SendKeys (.Offset(0, 1).Value2)
                SendKeys ("{ENTER}")
                SendKeys ("{ENTER}")

'                ActiveCell.Offset(1, -4).Activate
                Set rCll = .Offset(1, -4)

            Else
'                ActiveCell.Offset(1, 0).Activate
                rCll = .Offset(1, 0)

        End If: End With

    Loop

Exit Sub
ErrorHelper:
    MsgBox Err.Description

End Sub

但是，您可以通过更早地识别和声明目标范围来避免使用 Do...Loop

Sub Scrap_Using_Range()
Dim rTrg As Range
Dim rCll As Range
On Error GoTo ErrorHelper


    Set rCll = ThisWorkbook.Sheets("Roundup").Range("I2") 'If Procedure resides is Workbook with data
    'Set rCll = Workbooks(WbkName).Sheets("Roundup").Range("I2") 'If Procedure does not reside is Workbook with data

    With rCll
        Set rTrg = IIf(.Offset(1, 0).Value2 = Empty, .Cells, Range(.Cells, .Cells.End(xlDown)))
    End With

    Call Shell("C:\Program Files\QAD\QAD Enterprise Applications 2.9.6\QAD.Applications.exe", vbNormalFocus)

    'Sign in to QAD
    Application.Wait (Now + TimeValue("0:00:05"))
        SendKeys ("username")
        SendKeys ("{TAB}")
        SendKeys ("password")
        SendKeys ("{ENTER}")

    'Enter Scrap
    Application.Wait (Now + TimeValue("0:00:15"))
        SendKeys ("{TAB}")
    Application.Wait (Now + TimeValue("0:00:01"))
        SendKeys ("{TAB}")
    Application.Wait (Now + TimeValue("0:00:01"))

    'Scrap Loop
    For Each rCll In rTrg
        With rCll
            If .Value2 > 0 Then
                SendKeys (.Offset(0, -8).Value2)

                SendKeys ("{ENTER}")
                SendKeys (.Offset(0, 6).Value2)
                SendKeys ("{TAB}")
                SendKeys ("{TAB}")
                SendKeys ("{TAB}")

                Application.Wait (Now + TimeValue("0:00:01"))
                SendKeys (.Offset(0, -1).Value2)
                SendKeys ("{ENTER}")
                SendKeys ("{TAB}")
                SendKeys ("{TAB}")

                Application.Wait (Now + TimeValue("0:00:01"))
                SendKeys ("SCRAP")
                SendKeys ("{TAB}")
                SendKeys ("{TAB}")
                SendKeys ("{TAB}")
                SendKeys ("{TAB}")

                Application.Wait (Now + TimeValue("0:00:01"))
                SendKeys (.Offset(0, 2).Value2)
                SendKeys ("{TAB}")

                SendKeys (.Offset(0, -4).Value2)
                SendKeys ("{TAB}")

                SendKeys (.Offset(0, 1).Value2)
                SendKeys ("{ENTER}")
                SendKeys ("{ENTER}")

    End If: End With: Next

Exit Sub
ErrorHelper:
    MsgBox Err.Description

End Sub

无处不在：应用程序定义或对象定义的错误

The Ubiquitous: Application defined or object defined error

excel

if-statement

error-handling

sendkeys

vba