「図形の変更」で切れたコネクタをつなぎ直す

昨日は、オートシェイプの配置位置とサイズを、ぴったりとセルに合わせる修正を行いました。

infoment.hatenablog.com

今日は、図形の変更で切れたコネクタのつなぎ直しに挑戦です。

今日やりたいこと

先日は、選択したオートシェイプに対し「図形の変更」機能を設けました。

infoment.hatenablog.com

図形の変更自体はうまくいきました。しかしその後、接続済みコネクタがあった場合、接続が切れてしまうことが分かりました。そこで、どうすれば繋ぎ直せるかを検討します。

必要なこと

1. コンボボックスのコード改修

現状は、コンボボックスの値が変わったタイミングで図形の変更を行っています。そこで、ここで一気に再接続までを行います。

１．コンボボックスのコード改修

コネクタであれば、ConnectorFormat で以下の情報を取得可能です。

• 始点が接続されたオートシェイプそのもの
• 終点が接続されたオートシェイプそのもの
• 始点および終点が接続された位置

しかしコネクタ以外について ConnectorFormat に類する情報を、直接取得することはできないようです。

そこで回りくどいですが、以下の順序で行うことにしました。

1. 選択中のオートシェイプ（コネクタを除く）について、IDを辞書（連想配列）に登録する
2. シート内のすべてのコネクタをループし、始点および終点が接続されたオートシェイプ（選択中のものに限る）の情報を配列に格納する
3. 図形の変更を実施
4. すべてのコネクタについて、変更前に登録しておいた情報で再接続
   接続が切れているか否かは不問で、とにかく全部つなぎ直す。

【ユーザーフォームのモジュール】（EditShapeForm）

Private Sub ComboBox1_Change()

    ' コンボボックスのリスト追加時動作は、ここで終了させる。
    If ComboBox1.Value = "" Then
        Exit Sub
    End If
    
    ' 選択中のオートシェイプ（コネクタを除く）について、
    ' そのIDを辞書（連想配列）に登録する。
    ' ※「Microsoft Scripting Runtime」参照済み。
    Dim DictOfShape As Dictionary
    Set DictOfShape = New Dictionary
    Dim Shape As Shape
        For Each Shape In Selection.ShapeRange
            If Shape.Connector = msoFalse Then
                DictOfShape(Shape.ID) = True
            End If
        Next
    
    ' 各コネクタについて、始点および終点の情報を取得して配列に格納する。
    ' ※接続先オートシェイプのIDが、上記辞書に登録されている場合に限る。
    Dim SC() As ShapeClass:      ReDim SC(0)
    Dim start_shape() As Shape:  ReDim start_shape(0)
    Dim StartPosition() As Long: ReDim StartPosition(0)
    Dim end_shape() As Shape:    ReDim end_shape(0)
    Dim EndPosition() As Long:   ReDim EndPosition(0)
    Dim i As Long
        i = 0
        For Each Shape In ActiveSheet.Shapes
            If Shape.Connector = msoTrue Then
                ' 接続先が無いコネクタのエラーを無視する。
                On Error Resume Next
                ' コネクタの始点が接続されたオートシェイプ
                Set start_shape(i) = Shape.ConnectorFormat.BeginConnectedShape
                ' コネクタの始点接続先
                StartPosition(i) = Shape.ConnectorFormat.BeginConnectionSite
                ' コネクタの終点が接続されたオートシェイプ
                Set end_shape(i) = Shape.ConnectorFormat.EndConnectedShape
                ' コネクタの終点接続先
                EndPosition(i) = Shape.ConnectorFormat.EndConnectionSite
                If DictOfShape.Exists(start_shape(i).ID) = True Or _
                   DictOfShape.Exists(end_shape(i).ID) = True Then
                    Set SC(i) = New ShapeClass
                    Set SC(i).myShape = Shape
                    i = i + 1
                    ReDim Preserve SC(i)
                    ReDim Preserve start_shape(i)
                    ReDim Preserve StartPosition(i)
                    ReDim Preserve end_shape(i)
                    ReDim Preserve EndPosition(i)
                End If
            End If
        Next
    ReDim Preserve SC(i - 1)
    ReDim Preserve start_shape(i - 1)
    ReDim Preserve StartPosition(i - 1)
    ReDim Preserve end_shape(i - 1)
    ReDim Preserve EndPosition(i - 1)
        
        ' 選択されたオートシェイプに対し「図形の変更」を実施。
        Selection.ShapeRange.AutoShapeType = ComboBox1.Value
                   
        ' コネクタを元のオートシェイプに再接続。
        For i = 0 To UBound(SC)
            SC(i).myShape.ConnectorFormat.BeginConnect start_shape(i), StartPosition(i)
            SC(i).myShape.ConnectorFormat.EndConnect end_shape(i), EndPosition(i)
        Next
    
End Sub

結果

図形の変更後も、コネクタの接続が維持されるようになりました。

次回に続きます。

参考まで。