How to resume the Loop after Error Handling? - excel

Question

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

Answer 1

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.

Answer 2

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