2016-10-25 23 views
1

2つの図形のグループを結ぶ線の名前を構成するコードを選択しました。グループ名は列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がフリーズし、エスケープする必要があります。

答えて

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 
+0

また、私は多くの場合にテストループを書くまた、あなたがより多くのこのような何かにあなたのメインループを簡素化することができます'Debug.Print'すべてのオブジェクトのすべての名前のリスト。作成した名前が実際に既存の名前と一致することを確認するだけです。時には、比較が機能していることを確認するために、テストループに 'If'ステートメントを追加しなければならないことがありました(ちょっとしたスペースや印刷できない文字との不一致の場合)。 – PeterT

+0

@PeterT - 同意します。問題の根源は、「特定の条件セットに対してtargetLine1のグループ名が存在しない可能性があります」と考えられますが、OPはそれを解決する方法でリファクタリングを容易にする情報を提供しません。 – Comintern

+0

これでコードを実行すると、Excelがフリーズしてしまいました。 –

0

コミンテルンの答え:私は形状/オブジェクト名に関する問題に遭遇したときに

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 
関連する問題