Office関連

図形の書式設定ウィンドウ内のコントロールをすべて展開するPowerPointマクロ

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

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

標準機能にはそういったオプションが用意されていないと思うので、ここはマクロでの処理を考えてみます。こういった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起動時にマクロを実行することはできなくもないのですが、書式設定のウィンドウは図形選択時でないと表示できないため、下記記事のような方法で、クイックアクセスツールバーから好きなタイミングで実行できるようにした方が使いやすいのではないかと思います。

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

関連記事

  1. Office関連

    [Office 2016]コマンド検索即実行、便利な「Tell Me」機能

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

  2. Office関連

    SkyDriveの同期フォルダーのパスを取得するWordマクロ

    無料で使える便利なクラウドストレージ「SkyDrive」にはローカルフ…

  3. Office関連

    [Word VBA]ルビ(ふりがな)ダイアログの操作に挑む(2)

    2016/10/28 追記:改良版のマクロを書きました。…

  4. Office関連

    Office 365 APIをVBAから呼び出す(2)

    前回の記事ではOffice 365とAzure ADの紐づけを行いまし…

  5. Office関連

    「最速攻略 Wordマクロ/VBA徹底入門」レビュー

    いつもお世話になっているExcel MVPの伊藤さんに9月20日発売予…

コメント

  • コメント (0)

  • トラックバックは利用できません。

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

Time limit is exhausted. Please reload CAPTCHA.

最近の記事

アーカイブ

RapidSSL_SEAL-90x50
PAGE TOP