図形の変更により途切れたコネクタをVBAで再接続する： Excel VBA

この記事は，オートシェイプをたくさん選択して「図形の変更」をした結果，コネクタ全部切れてる…となってしまった状態から，VBAを使ってコネクタをつなぎ直すコードの紹介になります。

' 図形のコネクタ接続点の座標を取得する
Sub GetConnectionSitePosition(shape As shape, index As Long, ByRef posX As Double, ByRef posY As Double)
    Dim s_conn As shape
    Dim center_x As Double
    Dim center_y As Double
    center_x = shape.LEFT + shape.Width / 2#
    center_y = shape.TOP + shape.Height / 2#
 
    ' 試しに接続点に直線コネクタを接続してみる
    Set s_conn = shape.TopLeftCell.Worksheet.Shapes.AddConnector(msoConnectorStraight, center_x, center_y, shape.LEFT, shape.TOP)
    Call s_conn.ConnectorFormat.EndConnect(shape, index)
 
    ' 接続したコネクタの終点を取得する
    Call GetConnectorPointPosition(s_conn, center_x, center_y, posX, posY)
 
    ' コネクタを始末する
    s_conn.Delete
End Sub
 
 
' コネクタの始点・終点の座標を取得する
Sub GetConnectorPointPosition(shape As shape, ByRef startX As Double, ByRef startY As Double, ByRef endX As Double, ByRef endY As Double)
    Dim RIGHT As Integer, _
        LEFT As Integer, _
        TOP As Integer, _
        BOTTOM As Integer, _
        P_START As Integer, _
        P_END As Integer
    Dim NPmap(2, 2) As Integer
    Dim i As Integer, _
        temp As Integer
 
    LEFT = 1
    RIGHT = 2
    TOP = 1
    BOTTOM = 2
    P_START = 1
    P_END = 2
 
    ' DEFAULT
    NPmap(TOP, LEFT) = P_START
    NPmap(TOP, RIGHT) = 0
    NPmap(BOTTOM, LEFT) = 0
    NPmap(BOTTOM, RIGHT) = P_END
 
    ' V-FLIP
    If shape.VerticalFlip = msoTrue Then
        For i = LEFT To RIGHT
            temp = NPmap(TOP, i)
            NPmap(TOP, i) = NPmap(BOTTOM, i)
            NPmap(BOTTOM, i) = temp
        Next
    End If
 
    ' H-FLIP
    If shape.HorizontalFlip = msoTrue Then
        For i = TOP To BOTTOM
            temp = NPmap(i, LEFT)
            NPmap(i, LEFT) = NPmap(i, RIGHT)
            NPmap(i, RIGHT) = temp
        Next
    End If
 
    ' ROT
    Dim rot As Integer
    rot = shape.Rotation
    Do While rot > 0
        rot = rot - 90
        temp = NPmap(TOP, LEFT)
        NPmap(TOP, LEFT) = NPmap(BOTTOM, LEFT)
        NPmap(BOTTOM, LEFT) = NPmap(BOTTOM, RIGHT)
        NPmap(BOTTOM, RIGHT) = NPmap(TOP, RIGHT)
        NPmap(TOP, RIGHT) = temp
    Loop
 
    ' Set Position
    Dim x As Integer, y As Integer, z As Integer
    Dim res(2, 2) As Integer
    For z = P_START To P_END
        For y = TOP To BOTTOM
            For x = LEFT To RIGHT
                If NPmap(y, x) = z Then
                    If x = LEFT Then
                        res(z, 1) = shape.LEFT
                    Else
                        res(z, 1) = shape.LEFT + shape.Width
                    End If
                    If y = TOP Then
                        res(z, 2) = shape.TOP
                    Else
                        res(z, 2) = shape.TOP + shape.Height
                    End If
                End If
            Next
        Next
    Next
    startX = res(P_START, 1)
    startY = res(P_START, 2)
    endX = res(P_END, 1)
    endY = res(P_END, 2)
End Sub
' 図形の変更によって途切れてしまったコネクタを再接続する。
Sub ConnectorReconnect()
    Dim sh As Worksheet
    Set sh = ActiveSheet
    Dim v As Variant
    Dim v2 As Variant
    Dim s As shape
    Dim s2 As shape
 
    Dim conn_pos_x As New Dictionary
    Dim conn_pos_y As New Dictionary
    Dim spcs_pos_x As New Dictionary
    Dim spcs_pos_y As New Dictionary
 
    Dim hex_id As String
    Dim x1 As Double
    Dim x2 As Double
    Dim y1 As Double
    Dim y2 As Double
    Dim xx As Double
    Dim yy As Double
    Dim dist As Double
    Dim site As Long
    Dim count As Long
 
    Dim idx1 As Long
    Dim idx2 As Long
 
    ' コネクタの位置情報を収集する
    For count = 1 To sh.Shapes.count
        Set s = sh.Shapes.Item(count)
        hex_id = Format(count, "000000000")
        If s.Connector Then
            Call GetConnectorPointPosition(s, x1, y1, x2, y2)
            Call conn_pos_x.Add(hex_id & " " & "BEGIN", x1)
            Call conn_pos_x.Add(hex_id & " " & "END", x2)
            Call conn_pos_y.Add(hex_id & " " & "BEGIN", y1)
            Call conn_pos_y.Add(hex_id & " " & "END", y2)
        Else
            For site = 1 To s.ConnectionSiteCount
                Call GetConnectionSitePosition(s, site, x1, y1)
                Call spcs_pos_x.Add(hex_id & " " & site, x1)
                Call spcs_pos_y.Add(hex_id & " " & site, y1)
            Next
        End If
    Next
 
    ' 距離が近いものを接続する
    count = 0
    For Each v In spcs_pos_x.Keys
        For Each v2 In conn_pos_x.Keys
            x1 = spcs_pos_x(v)
            y1 = spcs_pos_y(v)
            x2 = conn_pos_x(v2)
            y2 = conn_pos_y(v2)
            xx = x2 - x1
            yy = y2 - y1
            xx = xx * xx
            yy = yy * yy
            dist = Sqr(xx + yy)
            If dist < 3 Then
                count = count + 1
                Debug.Print Format(count, "000:") & "[" & v & "]-[" & v2 & "] = (" & x1 & "," & y1 & ")-(" & x2 & "," & y2 & ")"
                idx1 = CLng(LEFT(v, 9))
                idx2 = CLng(LEFT(v2, 9))
                Set s = sh.Shapes.Item(idx1)
                Set s2 = sh.Shapes.Item(idx2)
                site = CLng(Mid(v, 11))
                If Mid(v2, 11) = "BEGIN" Then
                    Call s2.ConnectorFormat.BeginConnect(s, site)
                Else
                    Call s2.ConnectorFormat.EndConnect(s, site)
                End If
            End If
        Next
    Next
End Sub
 
' どこにも接続されていないコネクタの端点を〇で囲む
Sub PutCircleAtNotConnectedConnector()
    Dim sh As Worksheet
    Set sh = ActiveSheet
    Dim s As shape
    Dim s2 As shape
    Dim hex_id As String
    Dim x1 As Double
    Dim x2 As Double
    Dim y1 As Double
    Dim y2 As Double
    Dim count As Long
    ' コネクタの位置情報を収集する
    For count = 1 To sh.Shapes.count
        Set s = sh.Shapes.Item(count)
        hex_id = Format(count, "000000000")
        If s.Connector Then
            Call GetConnectorPointPosition(s, x1, y1, x2, y2)
            If Not s.ConnectorFormat.BeginConnected Then
                Set s2 = sh.Shapes.AddShape(msoShapeOval, x1 - 3#, y1 - 3#, 6, 6)
                s2.Line.ForeColor.RGB = RGB(255, 0, 0)
                s2.Line.Weight = 2
            End If
            If Not s.ConnectorFormat.EndConnected Then
                Set s2 = sh.Shapes.AddShape(msoShapeOval, x2 - 3#, y2 - 3#, 6, 6)
                s2.Line.ForeColor.RGB = RGB(255, 0, 0)
                s2.Line.Weight = 2
            End If
 
        End If
    Next
End Sub

さて，このコードの少しヤヤコシイところは「コネクタの始点・終点の座標を取得する」サブルーチンである「Sub GetConnectorPointPosition」になります。

というのも，コネクタ形状オブジェクトからコネクタの端点の位置を取得するためのプロパティはどうやら無いみたいなんですね。

コネクタ形状オブジェクトから得られる位置情報は，通常の図形と同じく Top, Left, Width, Height のみ。ここからどうやって端点の位置を取得するかというのが腕の見せ所になります。

コネクタの形状は様々で，Top, Left, Width, Heightだけの情報じゃ端点の位置を特定できないのは言うまでもありません。しかし，コネクタの形状（というか向きなんですが）を得る方法があります。それが，以下のプロパティです。

shape.VerticalFlip
shape.HorizontalFlip
shape.Rotation

そして，そもそもコネクタのTop, Left, Width, Height がどこの寸法を指しているのかということも理解しておく必要がありますので，以下の図を見てください。

基本的なコネクタ（線）はこれです。

このときの Top, Left, Width, Height はこうなります。

普通ですね。

しかし，次の場合はどうでしょう。

おや？コネクタの線がWidthをはみだしました。

このことから，コネクタのTop, Left, Width, Heightは，始点・終点を含む最小の矩形を指していることがわかります。途中の線は関係ないのですね。（途中の線は Adjustments プロパティで設定されます。）

これなら，矩形の頂点のいずれかに必ずコネクタの端点がくることになります。

あとは，コネクタの向きを調べて，矩形の頂点のどれがコネクタの始点で，どれがコネクタの終点なのかを特定すればOKです。

そのために

shape.VerticalFlip
shape.HorizontalFlip
shape.Rotation

を使うのです。

まず，基本形は次の向きです。

このとき，BEGIN=(Left, Top)，END=(Left+Width, Top+Height)にあります。

次は HorizontalFlip

はい。左右反転です。
このとき，BEGIN=(Left+Width, Top)，END=(Left, Top+Height)にあります。

次はVerticalFlip

はい。上下反転です。
このとき，BEGIN=(Left, Top+Height)，END=(Left+Width, Top)にあります。

次はRotation，回転ですね。時計回りに（右へ）90度ずつ回転します。

これらの反転と回転は，組み合わせでかかっている場合もあります。

ということで，これらの組み合わせを読み解けば，Top, Left, Width, Heightから始点および終点の位置を特定することが可能なわけです。

「Sub GetConnectorPointPosition」の中では，H-FLIP，V-FLIP，ROTとコメントした場所で，始点・終点がどこにあるのかを求めています。求めているというか，２行２列の配列を次のような配置に見立て，始点ならP_START(=1)，終点ならP_END(=2)を入れて置き，配列を反転させたり回したりしているだけです。

	LEFT	RIGHT
TOP	1	0
BOTTOM	0	2

配列のイメージ

標準形では始点(1)はTOP,LEFTに，終点(2)はBOTTOM,RIGHTにあるので，このように初期化しておき，H-FLIP，V-FLIP，ROTで1,2を入れ替えているわけです。これで端点がどっち側にあるのかわかるので，あとはTop, Left, Width, Heightを使って位置を計算して返せばOKなのです。

図形の変更により途切れたコネクタをVBAで再接続する： Excel VBA

投稿者: ahox 投稿日: 2020-08-262020-08-26