選択したコネクタの中間点に新たなオートシェイプを配置する

昨日、一昨日の二日間にわたって、スピンボタンのupとdownを押してコネクタの接続位置を変化させてみました。

infoment.hatenablog.com

今日は、コネクタ選択したコネクタの中間位置に、新たなオートシェイプを配置することに挑戦です。

今日やりたいこと
必要なこと
結果

今日やりたいこと

処理や分岐間に新たな処理などが追加されることは、よくあることだと思います。この場合、一般的に以下手順での追加作業になります。

コネクタを削除
新たなオートシェイプを良きところに配置
前後をコネクタでつなぐ

そこで、これを自動で行う機能を追加してみます。

必要なこと

テキストボックスとコマンドボタンの配置
コマンドボタン押下時の処理を作成
コネクタリストの更新

１．テキストボックスとコマンドボタンの配置

オートシェイプの中身が空っぽだと、色々な場面でエラーになる恐れがあります。そこで中身の文字を指定したうえで、オートシェイプを追加することにしました。

f:id:Infoment:20180923071244p:plain

２．コマンドボタン押下時の処理を作成

先ほど追加した「ブロック追加」ボタンを押した際、以下の手順で処理を行うことにしました。

選択したコネクタを削除
削除したコネクタの始端と終端にあるオートシェイプの位置関係から、新たに追加する位置を決定
オートシェイプを追加
始端 ⇒ 新規 ⇒ 終端の順にコネクタ接続
コネクタのリスト更新

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

Private Sub AddChartButton_Click()

    ' コネクタ削除
    SC.myShape.Delete
    
    Dim PositionRelationIndex As Long
        PositionRelationIndex = SC.GetPositionRelation(start_shape, end_shape)
    Dim myLeft As Long
    Dim myTop As Long
        Select Case PositionRelationIndex
            ' 真上、真下の場合
            Case 1, 3
                myLeft = start_shape.Left
                myTop = (start_shape.Top + end_shape.Top) / 2
            ' 左横、右横の場合
            Case 2, 4
                myLeft = (start_shape.Left + end_shape.Left) / 2
                myTop = start_shape.Top
            ' 左斜め上、右斜め上の場合
            Case 5, 8
                myLeft = end_shape.Left
                myTop = start_shape.Top
            ' 左斜め下、右斜め下の場合
            Case 6, 7
                myLeft = start_shape.Left
                myTop = end_shape.Top
        End Select
    
    Set SC.myShape = ActiveSheet.Shapes.AddShape(msoShapeFlowchartProcess, myLeft, myTop, 100, 50)
        SC.myShape.TextFrame2.TextRange.Characters.Text = AddChartTextBox.Value
        SC.SetFormat
    
    Dim AddShape(3) As Shape
    Set AddShape(1) = start_shape
    Set AddShape(2) = SC.myShape
    Set AddShape(3) = end_shape
    
    Dim i As Long
        For i = 1 To 2
            ConnectShape AddShape(i), AddShape(i + 1)
        Next
        
    Call UpdateConnectorList

End Sub

３．コネクタリストの更新

上記コードの最後で、コネクタのリストを更新するサブプロシージャを呼び出しています。

Call UpdateConnectorList

現時点では存在しないサブプロシージャなので、これから作成します。といっても、ユーザーフォームの初期化時に一度行っているので、これを切り出して同プロシージャに充てることにします。

【標準モジュール】

Public Sub UpdateConnectorList()

    ' 一旦全てのオートシェイプ選択を解除
    Range("A1").Select

    Dim Shape As Shape
    Dim col As Collection
    Set col = New Collection
        For Each Shape In ActiveSheet.Shapes
            If Shape.Connector = msoTrue Then
                col.Add Shape.Name
            End If
        Next
    
    Dim SQC As SequenceClass
    Set SQC = New SequenceClass
        EditConnectorForm.ListBox2.Clear
        EditConnectorForm.ListBox2.List = SQC.ToArray(col)

End Sub

ユーザーフォームから取り出したため、「どのユーザーフォームか」を明示する必要があります。

 EditConnectorForm.ListBox2.List = SQC.ToArray(col)

そのままコピーしてエラーになることが（私は）よくあるので、（私の）注意が必要です。

切り出した分だけ、ユーザーフォームの初期化がすっきりしました。

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

Private Sub UserForm_Initialize()

        ' 今回切り出して置き換えた箇所
        Call UpdateConnectorList
        
        StartSpinButton.Value = StartSpinButton.Max / 2
        EndSpinButton.Value = EndSpinButton.Max / 2
        
End Sub