How to resume the Loop after Error Handling?

user_8910461 0
Viewed 67

This is a scirpt which is supposed to add picture into a Powerpoint Placeholders based on the value of selected cells in an Excel File. Whenever there is an error, the script is supposed to go to the error handling line, fixed it and resume back from where the error was.

However, when the script encounters an error, it will run the error handling line, then end sub. How can I make it resume from where the error was detected?

For example, let's say we have an error on this line

On Error GoTo ERIB
For IB = 6

The script will go to error handling

ERIB:
oSld1.Shapes.AddPicture( _
    FileName:="D:\Users\Transparent\AnorMale.png", _
    LinkToFile:=msoFalse, _
    SaveWithDocument:=msoTrue, Left:=50, Top:=30, Width:=100, Height:=50).Select

After the above code, it will proceed to line ERIE then End Sub. Instead, I would like the script to continue running from For IB = 7 until the end of the script.

Here's the code

Dim I As Integer
Dim oXL As Object 'Excel.Aplication
Dim OWB As Object 'Excel.workbook
Dim oSld1 As Slide
Dim oSld2 As Slide


Set oXL = CreateObject("Excel.Application")
Set OWB = oXL.Workbooks.Open(FileName:="D:\Users\1.  Working\Working.xlsm")
Set oSld1 = ActivePresentation.Slides(1)
Set oSld2 = ActivePresentation.Slides(2)

------------------------------------------------------------------------

On Error GoTo ERIB
For IB = 5 To 7
oSld1.Shapes.AddPicture( _
    FileName:="D:\Users\Transparent\" & OWB.Sheets("Listing").Range("B" & CStr(IB)).Value & "_hof.png", _
    LinkToFile:=msoFalse, _
    SaveWithDocument:=msoTrue, Left:=50, Top:=30, Width:=100, Height:=50).Select
Next IB

On Error GoTo ERIE
For IE = 5 To 7
oSld2.Shapes.AddPicture( _
    FileName:="D:\Users\Transparent\" & OWB.Sheets("Listing").Range("E" & CStr(IE)).Value & "_hof.png", _
    LinkToFile:=msoFalse, _
    SaveWithDocument:=msoTrue, Left:=50, Top:=30, Width:=100, Height:=50).Select
Next IE

OWB.Close
oXL.Quit
Set OWB = Nothing
Set oXL = Nothing

Exit Sub

ERIB:
oSld1.Shapes.AddPicture( _
    FileName:="D:\Users\Transparent\AnorMale.png", _
    LinkToFile:=msoFalse, _
    SaveWithDocument:=msoTrue, Left:=50, Top:=30, Width:=100, Height:=50).Select

ERIE:
oSld1.Shapes.AddPicture( _
    FileName:="D:\Users\Transparent\AnorMale.png", _
    LinkToFile:=msoFalse, _
    SaveWithDocument:=msoTrue, Left:=50, Top:=30, Width:=100, Height:=50).Select

End Sub
vba excel
2 Answers

You can simply put an statement Resume Next at the end of your error handler:

Sub test1()
    Dim myValues, sum As Long, count As Long, i As Long
    myValues = Array(2, 4, "A", 5, 10)

    On Error GoTo ERRHANDLER
    For i = LBound(myValues) To UBound(myValues)
        sum = sum + myValues(i)
        count = count + 1
    Next i
    Debug.Print "Sum: " & sum & "  Count: " & count
    Exit Sub
ERRHANDLER:
    Debug.Print "error: " & Err.Number, Err.Description
    Resume Next
End Sub

Or you can jump to a label:

Sub test2()
    Dim myValues, sum As Long, count As Long, i As Long
    myValues = Array(2, 4, "A", 5, 10)

    On Error GoTo ERRHANDLER
    For i = LBound(myValues) To UBound(myValues)
        sum = sum + myValues(i)
        count = count + 1
CONTINUELOOP:
    Next i
    Debug.Print "Sum: " & sum & "  Count: " & count
    Exit Sub
ERRHANDLER:
    Debug.Print "error: " & Err.Number, Err.Description
    Resume CONTINUELOOP
End Sub

However, consider two things:
a) if you already expect that something specific might fail (in your case adding the picture), it's maybe better to handle that locally. If your main problem is that the AddPicture fails because the image fail is missing, you should check the existance to avoid the error (use for example the Dir-command).

Sub test3()
    Dim myValues, sum As Long, count As Long, i As Long
    myValues = Array(2, 4, "A", 5, 10)
    
    For i = LBound(myValues) To UBound(myValues)
        On Error Resume Next
        sum = sum + myValues(i)
        If Err.Number <> 0 Then
            If Err.Number <> 13 Then Err.Raise Err.Number ' An error occurred and it wasn't Type mismatch
            Err.Clear
        Else
            count = count + 1
        End If
        On Error Goto 0
    Next i
    Debug.Print "Sum: " & sum & "  Count: " & count
    Exit Sub
End Sub

b) You need to be careful what you do in your error handler: If the AddPicture in the error handler fails, it will raise another error and this time it will not be caught. Consider to write a MyAddPicture-routine that does the error handling internally without affecting the rest of your code.

user_75997980

You should consider using a try function so that you encapsulate the error and don't have to go jumping all over the place.

The code below compiles without error but as I don't have your images it hasn't been tested.

Sub Test()

Dim I As Integer
Dim oXL As Object 'Excel.Aplication
Dim OWB As Object 'Excel.workbook
Dim oSld1 As Slide
Dim oSld2 As Slide


Set oXL = CreateObject("Excel.Application")
Set OWB = oXL.Workbooks.Open(Filename:="D:\Users\1.  Working\Working.xlsm")
Set oSld1 = ActivePresentation.Slides(1)
Set oSld2 = ActivePresentation.Slides(2)


Dim myParams As Variant
myParams = Array("", msoTrue, msoTrue, 50, 30, 100, 50)
Dim mySLide As PowerPoint.Slide

Const myError As Long = 42  ' put your own error number here
'------------------------------------------------------------------------

For IB = 5 To 7

    myParams(0) = "D:\Users\Transparent\" & OWB.Sheets("Listing").Range("B" & CStr(IB)).Value & "_hof.png"
    If Not TryAddPictureToSlide(oSld1, myParams, mySLide) Then
    
        myParams(0) = "D:\Users\Transparent\AnorMale.png"
        If Not TryAddPictureToSlide(oSld1, myParams, mySLide) Then
        
            Err.Raise _
                myError, _
                "Could not add " & myParams(0)
            
        End If
        
    End If
    
    'Do whatever needs to be done with myShape

Next IB



For IE = 5 To 7

    myParams(0) = "D:\Users\Transparent\" & OWB.Sheets("Listing").Range("E" & CStr(IE)).Value & "_hof.png"
    If Not TryAddPictureToSlide(oSld2, myParams, mySLide) Then
    
        myParams(0) = "D:\Users\Transparent\AnorMale.png"
        If Not TryAddPictureToSlide(oSld2, myParams, mySLide) Then
        
            Err.Raise _
                myError, _
                "Could not add " & "D:\Users\Transparent\" & OWB.Sheets("Listing").Range("E" & CStr(IE)).Value & "_hof.png"
            
        End If
        
    End If
    
Next
    'Do whatever needs to be done with myShape

OWB.Close
oXL.Quit
Set OWB = Nothing
Set oXL = Nothing

End Sub

Public Function TryAddPictureToSlide(ByRef ipSlide As PowerPoint.Slide, ByRef ipParams As Variant, opShape As PowerPoint.Shape) As Boolean
    
    
    On Error Resume Next
    Set opShape = _
        ipSlide.Shapes.AddPicture _
        ( _
            Filename:=ipParams(0), _
            LinkToFile:=ipParams(1), _
            SaveWithDocument:=ipParams(2), _
            Left:=ipParams(3), _
            Top:=ipParams(4), _
            Width:=ipParams(5), _
            Height:=ipParams(6))
    
    TryAddPictureToSlide = Err.Number = 0
        
    Err.Clear

End Function
user_71773460
Related