半角チルダ

ExcelVBA、その他。
覚え書きや、補足資料などのスクラップブック。
end-u(1037781)

■Shapeをカギ線コネクタでつないでみる

2008-09-29 21:00:00 | VBA Tips
oshiete1.goo.ne.jp の『このQ&Aについてブログを書く』ってやつをちょっとやってみたかっただけなの :D
マクロの登録を使って、オートシェイプどうしをカギ線矢印コネクタでつなぐ - 教えて!goo

ちょっと前のQ&Aで、Rectangle に OnAction でマクロ登録してコネクタで繋ぐというやつです。



Option Explicit

Sub prep() 'テストシート作成
  Dim i As Long

  With Sheets.Add
    For i = 1 To 4
      With .Rectangles.Add(i * 50, i * 30, 30, 10)
        .Interior.Color = vbBlue
        .OnAction = "try"
      End With
    Next
  End With
End Sub
'-------------------------------------------------
Sub try()
  Static x As String
  Dim ws  As Worksheet

  If Len(x) = 0 Then
    If MsgBox("connect?", vbYesNo) = vbNo Then Exit Sub
    x = Application.Caller
  Else
    Set ws = ActiveSheet
    With ws.Shapes.AddConnector(msoConnectorElbow, 0, 0, 0, 0)
      .Line.EndArrowheadStyle = msoArrowheadTriangle
      With .ConnectorFormat
        .BeginConnect ws.Shapes(x), 4
        .EndConnect ws.Shapes(Application.Caller), 2
      End With
      '.RerouteConnections '最短経路で再接続
    End With
    x = ""
    Set ws = Nothing
  End If
End Sub

余談ではありますが、最初のレスでエラーが出たのは多分2007の環境だったのでしょう。
>With ActiveSheet
>  With .Shapes.AddConnector(msoConnectorElbow, 0, 0, 0, 0)
>    .Line.EndArrowheadStyle = msoArrowheadTriangle
>    .ConnectorFormat.BeginConnect .Parent.Shapes(x), 4
この Parentプロパティ が曲者のようです。
2007からは Shape の 親は Shapes になったみたい。
Comment
  • X
  • Facebookでシェアする
  • はてなブックマークに追加する
  • LINEでシェアする