选择分组形状数组的错误处理失败答案

【问题标题】：Failed Error Handling for Selection of Grouped Shapes Array选择分组形状数组的错误处理失败
【发布时间】：2016-10-25 14:44:45
【问题描述】：

我在下面选择了一段代码，它们应该构造连接两组形状的线的名称。组名位于 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 冻结了，我必须打破它才能逃脱。

【问题讨论】：

标签： excel error-handling vba

【解决方案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

【讨论】：

另外，当我遇到涉及形状/对象名称的问题时，我经常向Debug.Print 写一个测试循环，列出所有对象的所有名称，只是为了验证我构造的名称实际上是匹配现有名称。有时我不得不在该测试循环中添加一个If 语句来验证比较是否有效（以防出现额外空格或不可打印字符的差异）。
@PeterT - 同意。问题的根源可能是“targetLine1 的组名称可能不存在特定的一组标准”，但 OP 没有提供任何有助于以解决该问题的方式进行重构的信息。
现在，当我运行代码时，它会冻结 Excel，我必须打破它才能退出。
@Comintern 只有 27 岁，我愿意
@Comintern 只有 27 岁，我认为不会那么重。

【解决方案2】：

共产国际的回答：

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

            End If

            targetRow2 = targetRow2 + 1

        Loop

    End If

    targetRow = targetRow + 1

Loop

End Sub

【讨论】：