excel - 无所不在: Application defined or object defined error

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

我在互联网上已经看到过多次对此错误的引用，但是似乎没有一个适用于我的具体情况。 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

这是您对代码进行的修改，请注意使用声明的变量，但仍显示原始行“已注释”

一般的假设是，Offset命令始终在此行中引用 ActiveCell:
Do While Not IsEmpty(ActiveCell)以此取代 Do While rCll.Value2 <> Empty
请注意，在 Exit Sub行之前添加了 ErrorHelper行，否则即使没有错误，它也始终显示错误消息。

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