Ошибка Ubiquitous: Определенная заявленная или объектная ошибка

Question

Я написал небольшой макрос, который вводит транзакции в нашу систему ERP, и, кажется, что-то похожее на gummed, когда оно определяет, будет ли второе местоположение, определенное в электронной таблице, больше нуля. Вот мой код:

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 

Это ваш код пересмотрен, использование примечание объявленных переменных, она по-прежнему показывает оригинальные линии «прокомментировал»

Общее предположение о том, что офсетные команды всегда относятся к 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