Twitterのタイムラインに下記はけた(@excelspeedup)氏のツイートが流れてきました。

【緩募】パワーポイントで、起動直後に、自動で下記を開いた状態にする方法はないでしょうか？

・図形の書式設定ウィンドウ
・その中の全ての項目（塗りつぶしとか線とか）

いちいち、全部開くのが面倒くさいです。

— はけた＠Excel最高の学び方発売中 (@excelspeedup) 2018年7月23日

今まで特に意識したことがありませんでしたが、なるほど、たしかに面倒くさいかもしれません。

標準機能にはそういったオプションが用意されていないと思うので、ここはマクロでの処理を考えてみます。こういったUI周りの操作で使うのは、毎度おなじみ「UI Automation」。簡単な処理を考えてみました。

※ 下記コードはWindows 10 Pro 64ビット版とOffice Professional Plus 2016 32ビット版で動作確認を行っています。

'UIAutomationClient(UIAutomationCore.dll)要参照
Option Explicit

Private Sub ToggleFormatDlgItems()
'図形の書式設定ウィンドウ内のコントロールをすべて展開
  Dim uiAuto As CUIAutomation
  Dim app As IUIAutomationElement
  Dim customCtrl As IUIAutomationElement
  Dim grpCtrl As IUIAutomationElement
  Dim cndBtn As IUIAutomationCondition
  Dim aryBtn As IUIAutomationElementArray
  Dim elmBtn As IUIAutomationElement
  Dim iptn As IUIAutomationInvokePattern
  Dim d As Date, i As Long
  Const CtrlID As String = "PictureFormatDialog"
  
  '図形の書式設定表示
  With Application.CommandBars
    If .GetEnabledMso(CtrlID) Then
      .ExecuteMso CtrlID
    Else
      Exit Sub
    End If
  End With
  
  'PowerPointアプリケーション取得
  Set uiAuto = New CUIAutomation
  Set app = GetElement(uiAuto, _
                       uiAuto.GetRootElement, _
                       UIA_ClassNamePropertyId, _
                       "PPTFrameClass")
  If app Is Nothing Then Exit Sub
  
  '図形の書式設定カスタム コントロール取得
  d = DateAdd("s", 2, Now())  'ループの制限時間:2秒
  Do
    Set customCtrl = GetElement(uiAuto, _
                                app, _
                                UIA_NamePropertyId, _
                                "図形の書式設定", _
                                UIA_CustomControlTypeId)
    If Now() > d Then Exit Do  '制限時間を過ぎたらループを抜ける
    DoEvents
  Loop While customCtrl Is Nothing
  If customCtrl Is Nothing Then Exit Sub
  
  'カスタム コントロール内のグループ取得
  Set grpCtrl = GetElement(uiAuto, _
                           customCtrl, _
                           UIA_ClassNamePropertyId, _
                           "NetUIElement", _
                           UIA_GroupControlTypeId)
  If grpCtrl Is Nothing Then Exit Sub
  
  'グループ内のボタン取得→押下
  Set cndBtn = uiAuto.CreatePropertyCondition( _
                 UIA_ClassNamePropertyId, _
                 "NetUIRibbonButton" _
               )
  Set aryBtn = grpCtrl.FindAll( _
                 TreeScope_Subtree, _
                 cndBtn _
               )
  If aryBtn.Length < 1 Then Exit Sub
  For i = aryBtn.Length - 1 To 0 Step -1
    Set elmBtn = aryBtn.GetElement(i)
    If elmBtn.GetCurrentPropertyValue(UIA_IsInvokePatternAvailablePropertyId) Then
      Set iptn = elmBtn.GetCurrentPattern(UIA_InvokePatternId)
      iptn.Invoke: DoEvents
      SelectListItems uiAuto, customCtrl
    End If
  Next
End Sub

Private Sub SelectListItems(ByVal uiAuto As CUIAutomation, _
                            ByVal elmParent As IUIAutomationElement)
'データ グリッド取得→グリッド内のコントロール選択
  Dim gridCtrl As IUIAutomationElement
  Dim cndListItems As IUIAutomationCondition
  Dim aryListItems As IUIAutomationElementArray
  Dim elmListItem As IUIAutomationElement
  Dim selptn As IUIAutomationSelectionItemPattern
  Dim i As Long
  
  Set gridCtrl = GetElement(uiAuto, _
                            elmParent, _
                            UIA_ClassNamePropertyId, _
                            "NetUIGalleryButtonGroup", _
                            UIA_DataGridControlTypeId)
  If gridCtrl Is Nothing Then Exit Sub
  Set cndListItems = uiAuto.CreatePropertyCondition( _
                       UIA_ControlTypePropertyId, _
                       UIA_ListItemControlTypeId _
                     )
  Set aryListItems = gridCtrl.FindAll( _
                       TreeScope_Subtree, _
                       cndListItems _
                     )
  If aryListItems.Length < 1 Then Exit Sub
  For i = aryListItems.Length - 1 To 0 Step -1
    Set elmListItem = aryListItems.GetElement(i)
    If elmListItem.GetCurrentPropertyValue(UIA_IsSelectionItemPatternAvailablePropertyId) Then
      Set selptn = elmListItem.GetCurrentPattern(UIA_SelectionItemPatternId)
      selptn.Select: DoEvents
      ToggleElements uiAuto, elmParent
    End If
  Next
End Sub

Private Sub ToggleElements(ByVal uiAuto As CUIAutomation, _
                           ByVal elmParent As IUIAutomationElement)
'ボタン(Toggle)取得→展開
  Dim cndTglElements As IUIAutomationCondition
  Dim aryTglElements As IUIAutomationElementArray
  Dim elmTgl As IUIAutomationElement
  Dim tglptn As IUIAutomationTogglePattern
  Dim i As Long
  
  Set cndTglElements = uiAuto.CreatePropertyCondition( _
                         UIA_ClassNamePropertyId, _
                         "NetUIRibbonButton" _
                       )
  Set aryTglElements = elmParent.FindAll( _
                         TreeScope_Subtree, _
                         cndTglElements _
                       )
  If aryTglElements.Length < 1 Then Exit Sub
  For i = 0 To aryTglElements.Length - 1
    Set elmTgl = aryTglElements.GetElement(i)
    If elmTgl.GetCurrentPropertyValue(UIA_IsTogglePatternAvailablePropertyId) Then
      If elmTgl.GetCurrentPropertyValue(UIA_ToggleToggleStatePropertyId) = False Then
        Set tglptn = elmTgl.GetCurrentPattern(UIA_TogglePatternId)
        tglptn.Toggle
      End If
    End If
  Next
End Sub

Private Function GetElement(ByVal uiAuto As CUIAutomation, _
                            ByVal elmParent As IUIAutomationElement, _
                            ByVal propertyId As Long, _
                            ByVal propertyValue As Variant, _
                            Optional ByVal ctrlType As Long = 0) As IUIAutomationElement
  Dim cndFirst As IUIAutomationCondition
  Dim cndSecond As IUIAutomationCondition
  
  Set cndFirst = uiAuto.CreatePropertyCondition( _
                   propertyId, _
                   propertyValue _
                 )
  If ctrlType <> 0 Then
    Set cndSecond = uiAuto.CreatePropertyCondition( _
                      UIA_ControlTypePropertyId, _
                      ctrlType _
                    )
    Set cndFirst = uiAuto.CreateAndCondition( _
                     cndFirst, _
                     cndSecond _
                   )
  End If
  Set GetElement = elmParent.FindFirst(TreeScope_Subtree, cndFirst)
End Function

ToggleFormatDlgItemsプロシージャーを実行すると、図形の書式設定ウィンドウを開き、ウィンドウ内の各項目を順番に展開していきます。
(作り込んではいないため、項目が展開されない場合もあります。)

仕組みは単純で、ウィンドウ内のコントロールを順番に取得し、クリック(というよりは各コントロールに適した操作を実行)しているだけです。

問題はマクロの実行方法で、はけた(@excelspeedup)氏のツイートにあるように、PowerPoint起動時にマクロを実行することはできなくもないのですが、書式設定のウィンドウは図形選択時でないと表示できないため、下記記事のような方法で、クイックアクセスツールバーから好きなタイミングで実行できるようにした方が使いやすいのではないかと思います。

2018.06.04

[リボン・カスタマイズ]クイック アクセス ツール バーに独自ボタンを追加してアドイン化する方法

「クイック アクセス ツール バーに独自マクロ(自作ボタン)を追加して、アドインとして登録したい」という質問をいただきました。 これまで、クイック アクセス ツール バーに独自マクロを追加する方法に関しては、いくつか記事を書いてきましたが(下記参照)、良...

2012.04.20

クイックアクセスツールバーからPowerPointマクロを実行するアドインの紹介

先日書いた「[Mayhem]PowerPointマクロにショートカットキーを割り当てる。」という記事に関連して、Excel MVPの伊藤さんが新しくマクロを公開されました。 "マクロを実行するダイアログ"で紹介しているマクロがそれで、ユーザーフォームから...

とりあえず、私の方でクイックアクセスツールバーからマクロを実行できるようにしたアドインファイルを作成しましたので、興味がある方はこちらからダウンロードしてお使いください。