Excel MVPの伊藤さんのブログで、PowerPointの「図形の結合」に関する記事が公開されていました。

・図形の結合を行うPowerPointマクロ
http://www.relief.jp/itnote/archives/powerpoint-vba-merge-shapes.php
・PowerPoint 2010で図形の結合を行う
http://www.relief.jp/itnote/archives/powerpoint-2010-merge-shapes.php

PowerPoint 2013で追加された、ShapeRangeオブジェクトのMergeShapesメソッドを使ったマクロと、PowerPoint 2010での図形の結合方法が紹介されています。

これまでPowerPointで図形を結合したことが無く、このコマンドがあったことすら知らなかったので大変勉強になりました。

そしてふと思ったのが、

“PowerPoint 2010でもコマンドが用意されているのであれば、ExecuteMsoメソッドで呼び出せば良いんじゃないか？”

ということ。

・・・というわけで、早速コードを考えてみました。

Public Sub Sample()
'[図形の型抜き/合成]実行
  With Application.CommandBars
    If .GetEnabledMso("ShapesCombine") Then .ExecuteMso "ShapesCombine"
  End With
End Sub

図形の選択状態 = コマンドが実行できるかどうかの判定はGetEnabledMsoメソッドを使えば簡単に行えます。

また、下記のようにすれば、結合の種類をユーザー側で選択することもできます。

Public Sub Sample2()
  Dim ret As String
  
  ret = VBA.InputBox("結合の種類を1から4の番号で選択してください。" & vbCrLf & vbCrLf & _
                     "1:図形の接合" & vbCrLf & _
                     "2:図形の型抜き/合成" & vbCrLf & _
                     "3:図形の重なり抽出" & vbCrLf & _
                     "4:図形の単純型抜き", "図形の結合実行")
  If StrPtr(ret) = 0 Or Len(Trim(ret)) < 1 Then Exit Sub
  ret = StrConv(ret, vbNarrow)
  Select Case Val(ret)
    Case 1 To 4
    Case Else: Exit Sub
  End Select
  ExecuteCombineShapes ret
End Sub

Private Sub ExecuteCombineShapes(ByVal idx As Long)
'図形の結合実行
  Dim aryMso(1 To 4) As String
  
  aryMso(1) = "ShapesUnion"     '図形の接合
  aryMso(2) = "ShapesCombine"   '図形の型抜き/合成
  aryMso(3) = "ShapesIntersect" '図形の重なり抽出
  aryMso(4) = "ShapesSubtract"  '図形の単純型抜き
  
  With Application.CommandBars
    If .GetEnabledMso(aryMso(idx)) Then
      .ExecuteMso aryMso(idx)
    Else
      MsgBox "図形を複数選択した状態で実行してください。", vbExclamation + vbSystemModal
    End If
  End With
End Sub

「図形の結合」、初めて使ってみましたが中々面白い機能です。