MS Excel VBA中的錯誤處理

Question

我在VBA循環中發生錯誤時有些麻煩。 首先，這是我正在使用的代碼

dl = 20
For dnme = 1 To 3
Select Case dnme
Case 1
drnme = kt + " 90"
nme = "door90"
drnme1 = nme
Case 2
drnme = kt + " dec"
nme = "door70" 'decorative glazed'
Case 3
drnme = kt + " gl"
nme = "door80" 'plain glazed'
End Select

On Error GoTo ErrorHandler
Set sh = Worksheets("kitchen doors").Shapes(drnme) 'This line here is where the problem is'
sh.Copy
ActiveSheet.Paste
    Selection.ShapeRange.Name = nme
    Selection.ShapeRange.Top = 50
    Selection.ShapeRange.Left = dl
    Selection.ShapeRange.Width = 150
    Selection.ShapeRange.Height = 220
25
dl = dl + 160
Next dnme

 Exit Sub
ErrorHandler:

GoTo 25

問題在於，當它嘗試訪問形狀時，形狀並不總是存在。 第一次通過循環，這很好。 轉到ErrorHandler，一切正常。 第二次通過，找不到形狀，它帶有“ End / Debug”錯誤框。 我無法弄清楚為什么它不直接進入ErrorHandler。 有什么建議么？

Answer 1

我知道這是一篇舊文章，但這也許會對其他人有所幫助。 使用原始代碼，但替換ErrorHandler：GoTo 25

同

ErrorHandler：繼續25

Answer 2

首先，您有一個只有3次迭代的for循環，而您有3個開關盒！！ 為什么不能將通用代碼移至新函數並稱之為三次？

此外，每個錯誤還有一個唯一的編號（如果VBA錯誤（如下標超出范圍等），或者一個描述（如果其是通用編號，如1004），以及其他辦公錯誤）。 您需要檢查錯誤號，然后決定如何繼續操作（如果跳過零件或變通）。

請仔細檢查這段代碼。.我已將您的通用代碼移到了一個新函數中，在該函數中，我們將調整形狀的大小。 如果缺少形狀，則我們將返回false，然后移至下一個形狀。

'i am assuming you have defined drnme, nme as strings and d1 as integer
'if not please do so
Dim drnme As String, nme As String, d1 As Integer

dl = 20

drnme = kt + " 90"
nme = "door90"
If ResizeShape(drnme, nme, d1) Then
    d1 = d1 + 160
End If
'Just call 
'ResizeShape(drnme, nme, d1)
'd1 = d1 + 160
'If you don't care if the shape exists or not to increase d1
'in that case whether the function returns true or false d1 will be increased

drnme = kt + " dec"
nme = "door70" 'decorative glazed'
If ResizeShape(drnme, nme, d1) Then
    d1 = d1 + 160
End If

drnme = kt + " gl"
nme = "door80" 'plain glazed'
If ResizeShape(drnme, nme, d1) Then
    d1 = d1 + 160
End If

ActiveSheet.Shapes("Txtdoors").Select
Selection.Characters.Text = kt & ":   " & kttxt
Worksheets("kts close").Protect Password:="UPS"


End Sub

'resizes the shape passed in.
'if the shape does not exists then returns false.
'in that case you can skip incrementing d1 by 160

Public Function ResizeShape(drnme As String, nme As String, d1 As Integer) As Integer
On Error GoTo ErrorHandler
Dim sh As Shape
Set sh = Worksheets("kitchen doors").Shapes(drnme)
sh.Copy
ActiveSheet.Paste
Selection.ShapeRange.Name = nme
Selection.ShapeRange.Top = 50
Selection.ShapeRange.Left = dl
Selection.ShapeRange.Width = 150
Selection.ShapeRange.Height = 220
Exit Function
ErrorHandler:
'Err -2147024809 will be raised if the shape does not exists
'then just return false
'for the other errors you can examine the number and go back to next line or the same line
'by using Resume Next or Resume
'not GOTO!!
If Err.Number = -2147024809 Or Err.Description = "The item with the specified name wasn't found." Then
    ResizeShape = False
    Exit Function
End If
End Function

Answer 3

對不起大家，我已經研究出了解決辦法。 清除錯誤代碼不起作用，所以我不得不使用許多GOTO代替，現在代碼起作用了（即使它不是最優雅的解決方案）。 下面是我的新代碼：

dl = 20
For dnme = 1 To 3
BeginLoop:
Select Case dnme
Case 1
drnme = kt + " 90"
nme = "door90"
drnme1 = nme
Case 2
drnme = kt + " dec"
nme = "door70" 'decorative glazed'
Case 3
drnme = kt + " gl"
nme = "door80" 'plain glazed'
Case Else
GoTo EndLoop
End Select

On Error GoTo ErrorHandler
Set sh = Worksheets("kitchen doors").Shapes(drnme)
sh.Copy
ActiveSheet.Paste
    Selection.ShapeRange.Name = nme
    Selection.ShapeRange.Top = 50
    Selection.ShapeRange.Left = dl
    Selection.ShapeRange.Width = 150
    Selection.ShapeRange.Height = 220
25
dl = dl + 160
Next dnme

EndLoop:
     ActiveSheet.Shapes("Txtdoors").Select
    Selection.Characters.Text = kt & ":   " & kttxt
 Worksheets("kts close").Protect Password:="UPS"

 Exit Sub
ErrorHandler:
Err.Clear
dl = dl + 160
dnme = dnme + 1
Resume BeginLoop
End Sub

Answer 4

在同一Worksheet上不能有兩個不同的具有相同名稱的ShapeRange對象。 是否有可能復制的現有Shape對象之一是ShapeRange的成員，該成員與您要創建的新ShapeRange對象之一具有相同的名稱？

Answer 5

天哪-您不應該使用Gotos進入和退出循環!!!

如果您想自己處理錯誤，請使用以下方法：

''turn off error handling temporarily
On Error Resume Next

''code that may cause error

If Err.Number <> 0 then
  ''clear error
  Err.clear
  ''do stuff to handle error
End if

''resume error handling
On Error GoTo ErrorHandler

編輯-試試這個- 沒有混亂的GOTOS

  dl = 20
  For dnme = 1 To 3

    Select Case dnme
      Case 1
        drnme = kt + " 90"
        nme = "door90"
        drnme1 = nme

      Case 2
        drnme = kt + " dec"
        nme = "door70" 'decorative glazed'

      Case 3
        drnme = kt + " gl"
        nme = "door80" 'plain glazed'

    End Select

    'temporarily disable error handling'
    On Error Resume Next
    Set sh = Worksheets("kitchen doors").Shapes(drnme)

    'save error'
    ErrNum = Err.Number

    'reset error handling'
    On Error GoTo ErrorHandler

    If ErrNum = 0 Then

      sh.Copy

      ActiveSheet.Paste

      Selection.ShapeRange.Name = nme
      Selection.ShapeRange.Top = 50
      Selection.ShapeRange.Left = dl
      Selection.ShapeRange.Width = 150
      Selection.ShapeRange.Height = 220

    End If

    dl = dl + 160

  Next dnme

  ActiveSheet.Shapes("Txtdoors").Select
  Selection.Characters.Text = kt & ":   " & kttxt
  Worksheets("kts close").Protect Password:="UPS"


NormalExit:
  Exit Sub

ErrorHandler:
  MsgBox "Error Occurred: " & Err.Number & " - " & Err.Description
  Exit Sub

End Sub