Fehlerbehandlung in MS Excel VBA

Question

Ich habe ein bisschen Probleme mit Fehlern in einer Schleife in VBA. Als erstes ist hier der Code, den ich

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 

Das Problem bin mit, dass, wenn es versucht, die Form zugreifen zu können, ist die Form nicht immer vorhanden ist. Das erste Mal durch die Schleife, das ist in Ordnung. Es geht zum ErrorHandler und alles funktioniert gut. Das zweite Mal, wenn es durchläuft und die Form nicht finden kann, kommt es zu dem Fehlerfeld "End/Debug". Ich kann nicht herausfinden, warum es nicht einfach zum ErrorHandler geht. Irgendwelche Vorschläge?

Answer 1

Zu allererst Sie haben für Schleife mit nur 3 Iterationen, und Sie haben einen Schalterfall für drei !!. Warum können Sie Ihren gemeinsamen Code nicht in eine neue Funktion verschieben und dreimal aufrufen?

Und mehr über jeden Fehler hat eine eindeutige Nummer (incase von VBA-Fehlern wie Index außerhalb des Bereichs usw., oder eine Beschreibung, wenn es eine generische Nummer wie 1004 und andere Office-Fehler). Sie müssen die Fehlernummer überprüfen und dann entscheiden, wie Sie vorgehen möchten, wenn Sie den Teil überspringen oder umgehen möchten.

Bitte gehen Sie durch diesen Code..Ich habe Ihren Comon-Code zu einer neuen Funktion bewegt, und in dieser Funktion werden wir die Form der Größe ändern. Wenn die Form fehlt, werden wir einfach false zurückgeben und zur nächsten Form wechseln.

'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 2

Entschuldigung, ich habe eine Lösung ausgearbeitet. Das Löschen des Fehlercodes funktionierte nicht, daher musste ich stattdessen eine Anzahl von GOTOs verwenden, und jetzt funktioniert der Code (auch wenn es nicht die eleganteste Lösung ist). Unten ist mein neuer Code:

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 3

Sie nicht zwei verschiedene ShapeRange Objekte mit dem gleichen Namen auf dem gleichen Worksheet haben. Besteht die Möglichkeit, dass eines der vorhandenen Shape Objekte, die kopiert werden, ein Mitglied eines ShapeRange mit demselben Namen wie eines der neuen ShapeRange Objekte ist, die Sie erstellen?

Answer 4

OMG - du solltest gotos nicht benutzen, um in eine Schleife hinein und aus ihr heraus zu kommen !!!

Wenn Sie einen Fehler zu handhaben wollen, um sich Sie so etwas wie folgt verwenden:

''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 

EDIT - versuchen, diese - keine unordentlichen 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 

Answer 5

Ich weiß, das ist ein alter Beitrag, aber vielleicht hilft das jemand anderem. den ursprünglichen Code verwenden, aber Fehlerbehandler ersetzen: GoTo 25

mit

Fehlerbehandler: Lebenslauf 25