矢印コネクタと仲良くなるための PowerPoint マクロ

動機

ワークフローを描いたり，簡単な説明図を作ったり，可換図式を描いたり，といった用途に使える便利ツールはいろいろあるのですが，仕事で使おうとすると，ほかの人にツール自体の布教をするのが面倒であったり，会社によっては導入のための申請の手間があったり，ということがあります．結局のところ，だれでも閲覧出来て，だれでも簡単に編集できるお絵描きソフトといえば PowerPoint です．コネクタを使えば図形を矢印で結ぶことは簡単なのですが，編集に手間がかかるので敬遠していました．今回はこの問題を，できるだけシンプルなマクロで改善することを試みます．

結論

複数の図形を選択して，以下のマクロを実行すると，「最初に選択した図形」から，「２番目以降に選択した図形」それぞれへのコネクタが作成されます．よくあるDNNの絵をイメージして作成しました．「どのカド（コネクションサイト）からコネクタを引っ張るか」については座標計算が必要かと思ってたのですが，RerouteConnections なる関数がすべて解決してくれました．

Sub arrowOneToN()
  ' 最初に選択した図形から，2番目以降に選択した図形のそれぞれに対して矢印コネクタを作成する
  Set thisPage = ActivePresentation.Slides(ActiveWindow.Selection.SlideRange.SlideIndex)
  Dim n As Integer
  If n < 2 Then
    MsgBox("Select 2 or more objects")
    Exit Sub
  End If
  Set src = ActiveWindow.Selection.ShapeRange(1)
  For i = 2 To n
    Set dst = ActiveWindow.Selection.Shaperange(i)
    With thisPage.Shapes.AddConnector(msoConnectorCurve, 0,0,0,0)
      With .ConnectorFormat
        .BeginConnect connectshapve:=src, connectionsite:=1
        .EndConnect connectshapve:=dst, connectionsite:=1
      End With
      With .Line
        .BeginArrowheadStyle = msoArrowheadNone
        .EndArrowheadStyle = msoArrowheadTriangle
        .EndArrowheadLength = 3
        .EndArrowheadWidth = 2
      End With
      .RerouteConnections  '最短経路になるようにコネクションサイトを選択しなおしてくれる
  Next
End Sub

RerouteConnections については，これ単独でマクロを作っても十分に便利さを感じられます．コネクタ作成後に図形の位置を調整したときなど，コネクタの接続位置が不自然になってしまったときは，調整したいコネクタを選択（複数可）してから以下のマクロを実行するとよいです．（図形が一緒に選択されていても動くようなので，図形選択は適当で大丈夫です）

Sub arrowReRoute()
  ' 選択された図形にコネクタが含まれている場合，最短経路になるように接続しなおす
  For Each s In ActiveWindow.selection.ShapeRange
    s.RerouteConnections
  Next
End Sub

また，一つ目のマクロの変形として，以下のようにすると，図形を選択した順に矢印でつなぐことができます．こちらも，先に図形を選択してから実行してください．

Sub arrowSerial()
  ' 図形を選択した順に，矢印コネクタを作成する
  Set thisPage = ActivePresentation.Slides(ActiveWindow.Selection.SlideRange.SlideIndex)
  Dim n As Integer
  If n < 2 Then
    MsgBox("Select 2 or more objects")
    Exit Sub
  End If
  For i = 2 To n
    Set src = ActiveWindow.Selection.ShapeRange(i-1)
    Set dst = ActiveWindow.Selection.Shaperange(i)
    With thisPage.Shapes.AddConnector(msoConnectorCurve, 0,0,0,0)
      With .ConnectorFormat
        .BeginConnect connectshapve:=src, connectionsite:=1
        .EndConnect connectshapve:=dst, connectionsite:=1
      End With
      With .Line
        .BeginArrowheadStyle = msoArrowheadNone
        .EndArrowheadStyle = msoArrowheadTriangle
        .EndArrowheadLength = 3
        .EndArrowheadWidth = 2
      End With
      .RerouteConnections  '最短経路になるようにコネクションサイトを選択しなおしてくれる
  Next
End Sub

おわりに

PowerPoint マクロは Excel マクロに比べて情報が少なく，たったこれだけのマクロに思いのほか時間がかかりました．とりあえず動くだけ，という状況なので，もう少しちゃんと勉強したいところです．