错误处理后如何恢复循环？
How to resume the Loop after Error Handling?
这是一个脚本，应该根据 Excel 文件中选定单元格的值将图片添加到 Powerpoint 占位符中。每当出现错误时，脚本应该转到错误处理行，修复它并从错误所在的位置恢复。
然而，当脚本遇到错误时，它会运行错误处理行，然后结束sub。我怎样才能让它从检测到错误的地方恢复？
例如，假设我们在这一行有一个错误
On Error GoTo ERIB
For IB = 6
脚本将进入错误处理
ERIB:
oSld1.Shapes.AddPicture( _
FileName:="D:\Users\Transparent\AnorMale.png", _
LinkToFile:=msoFalse, _
SaveWithDocument:=msoTrue, Left:=50, Top:=30, Width:=100, Height:=50).Select
在上面的代码之后，它将继续到第 ERIE 行，然后是 End Sub。
相反，我希望脚本从 For IB = 7 继续 运行ning 直到脚本结束。
这是代码
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. 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
您可以简单地在错误处理程序的末尾放置一个语句 Resume Next：
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
或者您可以跳转到标签：
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
但是，请考虑两件事：
a) 如果您已经 预期 某些特定的事情可能会失败（在您添加图片的情况下），最好在本地处理。如果您的主要问题是 AddPicture 失败，因为缺少图像失败，您应该检查是否存在以避免错误（例如使用 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) 你需要小心你在错误处理程序中所做的事情：如果错误处理程序中的 AddPicture 失败，它会引发另一个错误，这次它不会被捕获。考虑编写一个 MyAddPicture 例程，在不影响其余代码的情况下在内部进行错误处理。
您应该考虑使用 try 函数，这样您就可以封装错误，而不必到处跳转。
下面的代码编译没有错误，但由于我没有你的图片，所以还没有经过测试。
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. 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
这是一个脚本，应该根据 Excel 文件中选定单元格的值将图片添加到 Powerpoint 占位符中。每当出现错误时，脚本应该转到错误处理行，修复它并从错误所在的位置恢复。
然而，当脚本遇到错误时，它会运行错误处理行，然后结束sub。我怎样才能让它从检测到错误的地方恢复？
例如，假设我们在这一行有一个错误
On Error GoTo ERIB
For IB = 6
脚本将进入错误处理
ERIB:
oSld1.Shapes.AddPicture( _
FileName:="D:\Users\Transparent\AnorMale.png", _
LinkToFile:=msoFalse, _
SaveWithDocument:=msoTrue, Left:=50, Top:=30, Width:=100, Height:=50).Select
在上面的代码之后，它将继续到第 ERIE 行，然后是 End Sub。
相反，我希望脚本从 For IB = 7 继续 运行ning 直到脚本结束。
这是代码
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. 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
您可以简单地在错误处理程序的末尾放置一个语句 Resume Next：
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
或者您可以跳转到标签：
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
但是，请考虑两件事：
a) 如果您已经 预期 某些特定的事情可能会失败（在您添加图片的情况下），最好在本地处理。如果您的主要问题是 AddPicture 失败，因为缺少图像失败，您应该检查是否存在以避免错误（例如使用 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) 你需要小心你在错误处理程序中所做的事情：如果错误处理程序中的 AddPicture 失败，它会引发另一个错误，这次它不会被捕获。考虑编写一个 MyAddPicture 例程，在不影响其余代码的情况下在内部进行错误处理。
您应该考虑使用 try 函数，这样您就可以封装错误，而不必到处跳转。
下面的代码编译没有错误，但由于我没有你的图片，所以还没有经过测试。
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. 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