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

时间：2015-10-31 12:23:30

标签： excel excel-vba if-statement error-handling sendkeys vba

我写了一个小宏，将交易输入到我们的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语句的开头出错了。

有什么想法吗？

1 个答案:

答案 0 :(得分：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 ...循环

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
相关问题
最新问题