複数のオートシェイプをコネクタで連続接続する

昨日は、オートシェイプが選ばれた順序で、同オートシェイプを配列にセットしてみました。

infoment.hatenablog.com

今日は、選択したオートシェイプをコネクタで接続することに挑戦です。

今日やりたいこと

リストボックスに表示された複数のオートシェイプを選択し、選択した順序でコネクタを用いて接続します。

今回は、接続するまでを目標とします。従って以下については、次回以降の目標とします。

1. コネクタの種類を自動選択
2. どこからどこへ（例. 下から出て上へ、など）を自動選択

必要なここと

1. コネクタを描画する関数を作成
2. コネクタ連続描画用ボタン設置

１．コネクタを描画する関数を作成

コネクタを描画するために必要な情報は、以下の５つです。

1. コネクタの種類
2. 開始位置座標（ＸとＹの二つ）
3. 終了位置座標（ＸとＹの二つ）

そこで、この５つをそのまま引数にして、クラスモジュールに描画用関数を準備しました。なお、今回は手順として以下を踏む予定です。

1. まず線を引く
2. 二つのオートシェイプに始点と終点を接続する

従って、線を引いた時点での始点と終点は仮のもので、どこであっても結果は同じになります。そこで、何も指定しなければ（０，０）から（１００，１００）へ直線のコネクタを引くことにしました。

【クラスモジュール】（ShapeClass）

 Public Function DrawConnector(Optional connector_type As Long = 1, _
                               Optional begin_x As Double = 0, _
                               Optional begin_y As Double = 0, _
                               Optional end_x As Double = 100, _
                               Optional end_y As Double = 100) As Shape
                               
    Set DrawConnector = ActiveSheet.Shapes.AddConnector(connector_type, _
                                                        begin_x, _
                                                        begin_y, _
                                                        end_x, _
                                                        end_y)    
    With DrawConnector.Line
        ' 先端形状を設定。
        .EndArrowheadStyle = msoArrowheadTriangle
        ' コネクタの色を設定。
        .ForeColor.ObjectThemeColor = msoThemeColorText1
    End With                               
 End Function

※カギ型コネクタにする場合は、connector_type を 2 にします。

Sub DrawTest()
    Dim SC As ShapeClass
    Set SC = New ShapeClass
    Call SC.DrawConnector
End Sub

テスト結果は、とりあえず良好です。

２．コネクタ連続描画用ボタン設置

ユーザーフォームに、「接続」ボタンを設置します。

このボタンこそが、昨日に登場した「何か仕事をするサブルーチン」に該当します。仕事の内容は以下の通りです。

1. コネクタを仮の位置に描画
2. 仮に描画したコネクタの始点を、先に選択したオートシェイプに接続
3. 仮に描画したコネクタの終点を、次に選択したオートシェイプに接続

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

Private Sub ConnectButton_Click()
    If iMax = 2 Then Exit Sub

    Dim SC() As ShapeClass
    ReDim SC(1 To iMax - 1)
    Dim i As Long
        For i = 0 To ListBox1.ListCount - 1
            If ListBox1.Selected(i) = True Then
                Dim myID As Long
                    myID = ListBox1.List(i, 1)
                Dim myIndex As Long
                    myIndex = ListBox1.List(i, 2)
                    Set SC(myIndex) = New ShapeClass
                    Set SC(myIndex).myShape = TargetShape(myID)
            End If
        Next
        
        For i = 1 To iMax - 2
            Dim myArrow As Shape
            Set myArrow = SC(i).DrawConnector
            myArrow.ConnectorFormat.BeginConnect SC(i).myShape, 3
            myArrow.ConnectorFormat.EndConnect SC(i + 1).myShape, 1
        Next

End Sub

結果

意図したとおり、指定した複数のオートシェイプを、指定した順序でコネクタ接続できるようになりました。

次回に続きます。

参考まで。