无所不在:应用程序定义或对象定义的错误

I wrote a little macro that enters transactions into our ERP system and things seem to get gummed up when it's determining whether or not the second location defined in the spreadsheet is greater than zero. Here is my code:

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

    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

I've seen several references to this error on the internet but none that seem to apply to my specific situation. It seems to be going awry at the beginning of the If statement.

我在网上看到过几篇关于这个错误的文章，但没有一篇似乎适用于我的具体情况。在If语句的开头似乎出现了错误。

Any thoughts?

任何想法吗?

1 个解决方案

#1

I have done some adjustments to your code (see comments within code)

我对您的代码做了一些调整(请参阅代码中的注释)

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

This is your code revised, note use of declared variables, it still shows original lines "commented"

这是你修改的代码，注释使用声明变量，它仍然显示原始行“注释”

General assumption is that the Offset commands always refer to the ActiveCell in this line:

一般的假设是偏移命令总是指向这行中的ActiveCell:

Do While Not IsEmpty(ActiveCell) replace by this Do While rCll.Value2 <> Empty

当不为空(ActiveCell)替换为这个时，请执行rCll。Value2 < >空

Note the addition of the Exit Sub line before the ErrorHelper line otherwise it will always show the error message even if there is no error.

注意在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

However you can avoid the use of the Do...Loop by identifying and declaring your target range earlier

但是你可以避免使用Do…通过更早地识别和声明目标范围来循环

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

#1