VBAで図形同士をコネクタでつなげる
VBAで図形同士をコネクタで繋いでいく方法
現在、以下のようなことを行えるマクロを作成しています。
<表1>
Name, Distance, Next
A, 10, B
B, 5, D
C, 7, -
D, 15, C
<表1>の内容を元にしてNameの図形(四角)を用意。
A,B,C,Dそれぞれ図形があり、Distanceの数で図形の幅を変える。
Nextの順で図形をコネクタで順に繋いでいきます。
イメージ) [ A ] - [ B ] - [ D ] - [ C ]
単に図形を作成したり、コネクタで繋ぐだけならできたのですが、
表から名前を持ってきたりとかになると、お手上げ状態です。
Sub pre()
With Worksheets.Add
With .Rectangles
.Add(100, 100, 30, 10).Name = "A"
.Add(200, 200, 30, 10).Name = "B"
.Add(300, 300, 30, 10).Name = "C"
.Add(400, 400, 30, 10).Name = "D"
End With
.Range("A1:C5").Value = [{"name","d","next";"A",10,"B";"B",5,"D";"C",7,"-";"D",15,"C"}]
End With
End Sub
Sub try()
Dim r As Range
Dim s As Shape
Dim e As Shape
Dim c As Shape
Dim i As Long
With ActiveSheet
For Each r In .Range("A2", .Cells(.Rows.Count, 1).End(xlUp))
On Error Resume Next
Set s = .Shapes(r.Value)
If Not s Is Nothing Then
s.Width = r.Offset(, 1).Value
Set e = .Shapes(r.Offset(, 2).Value)
On Error GoTo 0
If Not e Is Nothing Then
'*****Connector処理
Set c = .Shapes.AddConnector(msoConnectorElbow, 0, 0, 0, 0)
c.Line.EndArrowheadStyle = msoArrowheadTriangle
With c.ConnectorFormat
.BeginConnect s, 4
.EndConnect e, 2
End With
'(最短経路で再接続)
'c.RerouteConnections
'*****
Set e = Nothing
End If
Set s = Nothing
End If
Next
End With
End Sub