excel - 选择分组形状阵列的错误处理失败

Question

我在下面选择了一些代码，这些代码应该用来构造连接两组形状的线的名称。组名位于A列中。基于C列中的条件，该代码更改了某些行的格式。

我的问题是，我不断收到“运行时错误'1004':在行上找不到具有指定名称的项目:

ActiveSheet.Shapes.Range(Array(targetLine1)).Select

对于特定的一组条件，targetLine1的组名可能不存在，但是我不明白为什么未处理该错误。我尝试同时使用On Error和If IsError来解决此问题，但两个都无法处理错误。

Sub SHOW_SINGLE_CONNECTIONS()

    Dim targetRow As Integer
    Dim targetRow2 As Integer
    Dim targetCell2 As String
    Dim targetCell3 As String

    Dim targetLine1 As String
    Dim targetLine2 As String

    targetRow = 2
    targetRow2 = 2

    Do Until IsEmpty(ActiveSheet.Range("A" & targetRow))
        targetCell2 = "A" & targetRow

        If (ActiveSheet.Range("C" & targetRow)) = "True" Then

            Do Until IsEmpty(ActiveSheet.Range("A" & targetRow2))
                targetCell3 = "A" & targetRow2

                If targetCell3 = targetCell2 Then
                    GoTo Spot1
                ElseIf (ActiveSheet.Range("C" & targetRow2)) = "False" Then
                    GoTo Spot1
                End If

                targetLine1 = ActiveSheet.Range(targetCell3).Value & "-" & ActiveSheet.Range(targetCell2).Value
                targetLine1 = Left(targetLine1, 32)
                targetLine2 = ActiveSheet.Range(targetCell2).Value & "-" & ActiveSheet.Range(targetCell3).Value
                targetLine2 = Left(targetLine2, 32)

                On Error GoTo Spot2
                ActiveSheet.Shapes.Range(Array(targetLine1)).Select
                With Selection.ShapeRange.Line
                    .Visible = msoTrue
                    .ForeColor.RGB = RGB(0, 0, 0)
                    .Transparency = 0
                End With

                Spot2:

                On Error GoTo Spot3
                ActiveSheet.Shapes.Range(Array(targetLine2)).Select
                With Selection.ShapeRange.Line
                    .Visible = msoTrue
                    .ForeColor.RGB = RGB(0, 0, 0)
                    .Transparency = 0
                End With

                Spot1:
                Spot3:

                targetRow2 = targetRow2 + 1

            Loop

        End If

        targetRow = targetRow + 1

    Loop
End Sub

第一次回应:

Private Sub TryFormatShape(targetLine As String)

On Error Resume Next
ActiveSheet.Shapes.Range(Array(targetLine)).Select
With Selection.ShapeRange.Line
    .Visible = msoTrue
    .ForeColor.RGB = RGB(0, 0, 0)
    .Transparency = 0
End With
Err.Clear
End Sub

Sub SHOW_SINGLE_CONNECTIONS()

Dim targetRow As Integer
Dim targetRow2 As Integer
Dim targetCell2 As String
Dim targetCell3 As String

Dim targetLine1 As String
Dim targetLine2 As String

targetRow = 2
targetRow2 = 2

Do Until IsEmpty(ActiveSheet.Range("A" & targetRow))
    targetCell2 = "A" & targetRow

    If (ActiveSheet.Range("C" & targetRow)) = "True" Then

        Do Until IsEmpty(ActiveSheet.Range("A" & targetRow2))
            targetCell3 = "A" & targetRow2

            If targetCell3 <> targetCell2 And (ActiveSheet.Range("C" & targetRow2)) = "True" Then

            MsgBox ActiveSheet.Range(targetCell3).Value
            MsgBox ActiveSheet.Range(targetCell2).Value

            targetLine1 = ActiveSheet.Range(targetCell3).Value & "-" & ActiveSheet.Range(targetCell2).Value
            targetLine1 = Left(targetLine1, 32)
            targetLine2 = ActiveSheet.Range(targetCell2).Value & "-" & ActiveSheet.Range(targetCell3).Value
            targetLine2 = Left(targetLine2, 32)

            TryFormatShape targetLine1
            TryFormatShape targetLine2

            targetRow2 = targetRow2 + 1

            End If

        Loop

    End If

    targetRow = targetRow + 1

Loop

End Sub

现在，当我运行代码时，Excel冻结，我必须将其破坏才能逃脱。

Answer 1

在代码再次通过循环运行之前，不会重置您的错误处理程序。实际上，我将摆脱所有GoTo语句，并提取Sub以实现常见功能:

Private Sub TryFormatShape(targetLine As String)
    On Error Resume Next
    ActiveSheet.Shapes.Range(Array(targetLine)).Select
    With Selection.ShapeRange.Line
        .Visible = msoTrue
        .ForeColor.RGB = RGB(0, 0, 0)
        .Transparency = 0
    End With
    Err.Clear
End Sub

这样，您就可以将错误处理隔离到新例程的上下文中，而不是遍历新例程。它还使您可以将主循环简化为以下形式:

        Do Until IsEmpty(ActiveSheet.Range("A" & targetRow2))
            targetCell3 = "A" & targetRow2

            If targetCell3 <> targetCell2 And (ActiveSheet.Range("C" & targetRow2)) <> "False" Then
                targetLine1 = ActiveSheet.Range(targetCell3).Value & "-" & ActiveSheet.Range(targetCell2).Value
                targetLine1 = Left(targetLine1, 32)
                targetLine2 = ActiveSheet.Range(targetCell2).Value & "-" & ActiveSheet.Range(targetCell3).Value
                targetLine2 = Left(targetLine2, 32)

                TryFormatShape targetLine1
                TryFormatShape targetLine2
            End If
            targetRow2 = targetRow2 + 1
        Loop