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巻&2巻前のページ

【2018年7月版】SeleniumBasicでMicrosoft Edgeを操作してみました。次のページ

関連記事

  1. Office アドイン

    [Officeアドイン]アドイン コマンド(Add-In Commands)の紹介(2)

    昨年末に書いた記事で「アドイン コマンド」を紹介しているのですが、知ら…

  2. アイコン一覧

    Office 365アイコン(imageMso)一覧(N)

    Office 365のデスクトップ版Officeアプリケーション(Wo…

  3. アイコン一覧

    Office 365アイコン(imageMso)一覧を作成するにあたって

    Office 2013のアイコン一覧を公開してから4年ほど経ち、その間…

  4. Office アドイン

    [Officeアドイン]マニフェストファイルをデバッグする方法

    Office アドイン本体はF12ツール等を使ってデバッグすることがで…

  5. Office関連

    起動中のMicrosoft EdgeからタイトルとURLを取得するVBAマクロ(UI Automat…

    当ブログでは、Microsoft Edgeを外部から操作するプログラム…

  6. Office アドイン

    Office Scripts機能によってWeb版Officeの操作を自動化する

    前回、Ignite 2019で発表されたPower Automate(…

コメント

  • コメント (0)

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

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

Time limit is exhausted. Please reload CAPTCHA.

Translate

最近の記事

アーカイブ

PAGE TOP