VBAで図形同士をコネクタで繋いでいく方法

質問

現在、以下のようなことを行えるマクロを作成しています。

＜表１＞
Name, Distance, Next
A,　　　10,　　　　　B
B,　　　5,　　　　　　D
C,　　　7,　　　　　　-
D,　　　15,　　　　　C

＜表１＞の内容を元にしてNameの図形（四角）を用意。
A,B,C,Dそれぞれ図形があり、Distanceの数で図形の幅を変える。
Nextの順で図形をコネクタで順に繋いでいきます。
イメージ）　[　 A 　] - [ B ] - [ D ] - [　　　C　　　]

単に図形を作成したり、コネクタで繋ぐだけならできたのですが、
表から名前を持ってきたりとかになると、お手上げ状態です。

どうかお知恵をお借りできないでしょうか。

環境　：　Windows7/Office 2010

回答No.1

end-u · ベストアンサー

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

こんなシートがあったとして、
取り敢えず基準となるA列をLoopして順番に処理する感じです。
セル値を読み取って図形を名前で識別します。
Shape型の変数に受けたほうが解りやすいかと思います。
#セル値には図形の名前を指定するのが前提ですが

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

Connectorについての処理はマクロ記録からでも参考になると思います。

お礼

ありがとうございました！
理想通りの動きで助かりました。
細かいアレンジは自力で頑張ってみます。