オートシェイプの位置関係をコネクタに自動で反映させる

Excel VBA 作ってみた クラスモジュール

昨日は、複数選択したオートシェイプを、選択順にコネクタで接続してみました。

infoment.hatenablog.com

今日は、オートシェイプの位置関係を自動で認識し、コネクタへ反映させることに挑戦です。

今日やりたいこと

昨日行ったのは、オートシェイプの位置関係に関わらず、とにかく下から上への接続でした。しかしこれでは、オートシェイプとコネクタが不自然に重なってしまい、多くの修正を要することになります。
そこで少しでも修正を減らすべく、コネクタがどこから出てどこに入るかを、ある程度コントロールしてみました。手順は、以下の通りです。

  1. 二つのオートシェイプについて、位置関係を把握する
  2. １．を踏まえたうえで、オートシェイプを描画する
  3. １．を踏まえたうえで、オートシェイプを接続する

必要なこと

  1. 二つのオートシェイプについて位置関係を把握して数値化
  2. １．を踏まえたうえで、オートシェイプを描画・接続

二つのオートシェイプを引数として与え、戻り値として位置関係を表す数値を返す関数があれば、便利そうです。

１．二つのオートシェイプについて位置関係を把握して数値化

今回は、位置関係を９つに分類し、それぞれを数で表すことにしました。
f:id:Infoment:20180917233258p:plain

八つの方位を、１～８の数字で表しています。また０は、オートシェイプ同士が重なっている場合を示すことにしました。

位置関係については、このように考えます。例えば中心から見て左にあるオートシェイプは、右端の座標が自身の左端の座標より小さいはずです。
f:id:Infoment:20180917233940p:plain

上下方向についても、同じことが言えます。

  • 上か、下か、真ん中かの３通り
  • 左か、右か、真ん中かの３通り

で、３×３で９通りとしたわけです。

【クラスモジュール】（ShapeClass）
' Shape1 から見た Shape2 の位置を数値化
'
'   5       1       8
'   2     shape1    4
'   6       3       7
Public Function GetPositionRelation(Shape1 As Shape, Shape2 As Shape) As Long
    Dim val As Long
        If Shape2.Left + Shape2.Width < Shape1.Left Then
            If Shape2.Top + Shape2.Height < Shape1.Top Then
                val = 5
            ElseIf Shape1.Top + Shape1.Height < Shape2.Top Then
                val = 6
            Else
                val = 2
            End If
        ElseIf Shape1.Left + Shape1.Width < Shape2.Left Then
            If Shape2.Top + Shape2.Height < Shape1.Top Then
                val = 8
            ElseIf Shape1.Top + Shape1.Height < Shape2.Top Then
                val = 7
            Else
                val = 4
            End If
        Else
            If Shape2.Top + Shape2.Height < Shape1.Top Then
                val = 1
            ElseIf Shape1.Top + Shape1.Height < Shape2.Top Then
                val = 3
            Else
                val = 0
            End If
        End If
        GetPositionRelation = val
End Function

２．１．を踏まえたうえで、オートシェイプを描画・接続

私のかつての上司は制御設計出身で、フローチャートの書き方を指南してくださいました。分野によって書き方は変わるのかもしれませんが、そのとき教わった基本ルールは以下の通りです。

  • コネクタは下または右から出る
  • コネクタは上または左から入る

例えば上から出て下から入る、といのはＮＧです。
f:id:Infoment:20180918063349p:plain

そこで、位置関係によって出口と入口を一つずつ設定し、描画して接続するまでを一つの関数にまとめました。
※方向によっては同じ設定のものもありますが、のちに変更する場合を考慮して、方位毎に設定してあります。

Public Sub ConnectShape(start_shape As Shape, end_shape As Shape)

    Dim SC As ShapeClass
    Set SC = New ShapeClass
    
    Dim PositionRelationIndex As Long
        PositionRelationIndex = SC.GetPositionRelation(start_shape, end_shape)
    
    Dim myArrow As Shape
    Dim StartPosition As Long
    Dim EndPosition As Long
        
        Select Case PositionRelationIndex
        
        ' 真上：下 ⇒ 上：カギ
            Case 1
                Set myArrow = SC.DrawConnector(2)
                StartPosition = 3
                EndPosition = 1
        
        ' 左横：下 ⇒ 上：カギ
            Case 2
                Set myArrow = SC.DrawConnector(2)
                StartPosition = 3
                EndPosition = 1
                
        ' 真下：下 ⇒ 上：直
            Case 3
                Set myArrow = SC.DrawConnector
                StartPosition = 3
                EndPosition = 1
        
        ' 右横：左 ⇒ 右：直
            Case 4
                Set myArrow = SC.DrawConnector
                StartPosition = 4
                EndPosition = 2
                
        ' 左上：下 ⇒ 上：カギ
            Case 5
                Set myArrow = SC.DrawConnector(2)
                StartPosition = 3
                EndPosition = 1

        ' 左下：下 ⇒ 上：カギ
            Case 6
                Set myArrow = SC.DrawConnector(2)
                StartPosition = 3
                EndPosition = 1

        ' 右下：下 ⇒ 上：カギ
            Case 7
                Set myArrow = SC.DrawConnector(2)
                StartPosition = 3
                EndPosition = 1
                
        ' 右上：右 ⇒ 左：カギ
            Case 8
                Set myArrow = SC.DrawConnector(2)
                StartPosition = 4
                EndPosition = 2
        
            Case Else
                Exit Sub
                
        End Select

        With myArrow
            .ConnectorFormat.BeginConnect start_shape, StartPosition
            .ConnectorFormat.EndConnect end_shape, EndPosition
        End With

End Sub

こちらで描画まで済ませたので、併せてユーザーフォーム側のマクロも変更です。

【ユーザーフォームのモジュール】
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
            Call ConnectShape(SC(i).myShape, SC(i + 1).myShape)
        Next
' --------------↑↑前回からの変更箇所↑↑--------------
End Sub

結果

オートシェイプの位置関係に合わせて自動でコネクタの種類を選択し、設定した位置で接続できるようになりました。
f:id:Infoment:20180918064517p:plain

次回に続きます。

参考まで。