Question

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

我的问题是我一直收到＆＃34;运行时错误＆＃39; 1004＆＃39;：在该行找不到具有指定名称的项目：

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

Answer 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

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

2 个答案: