Office関連

図形の結合を行うPowerPoint マクロ(ExecuteMsoメソッド編)

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

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

関連記事

  1. Office関連

    指定したファイルをエクスプローラーで開いて選択するVBAマクロ

    マクロから直接ファイルを開くこともできるけどファイルの操作はユーザーに…

  2. Office関連

    第4回Office 365勉強会に参加してきました。

    2013/3/2(土)に品川にあるMicrosoftオフィスでOffi…

  3. Office関連

    [リボン・カスタマイズ]dropDown要素の初期項目を指定する。

    MSDN フォーラムに「リボン:ドロップダウンリストにlabel初期値…

  4. Office関連

    Excel 2016 Previewで追加された新しい関数

    ※ 下記情報はOffice 2016 Preview版を元にしています…

  5. Office関連

    「2014年12月のWindows Update以降コマンドボタンが使えなくなった」トラブルへのFi…

    当ブログでも「KB2553154の更新プログラムをアンインストールする…

  6. Office関連

    Officeのヘルプを単独で開く。

    Officeアプリケーションのヘルプが見たいとき、いちいちアプリケーシ…

コメント

  1. この記事へのコメントはありません。

  1. この記事へのトラックバックはありません。

Time limit is exhausted. Please reload CAPTCHA.

最近の記事

アーカイブ

RapidSSL_SEAL-90x50
PAGE TOP