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 365 Solo]日本語環境以外では使えるの?

    Office 365 Soloを使ってみて、疑問に思ったことの一つが“…

  2. Office関連

    「ちゃうちゃう!」で2つの文書を比較するWordマクロ

    2014/08/10 追記:ちゃうちゃう!がバージョンアップされま…

  3. Office関連

    セル内にあるブックマークをカウントするWordマクロ

    Twitterを眺めていたら下記ツイートを発見しました。【Wo…

  4. Office関連

    [Word]隠し文字をクイックアクセスツールバーから設定する。

    Wordで、部分的に印刷したくない文字列がある場合には「隠し文字」がよ…

  5. Office関連

    Excelのアイデア機能でグラフやピボットグラフを一発作成

    Insider版のExcelに「アイデア」機能が追加されました。…

  6. Office関連

    [PowerPoint]シェイプの名前を指定して「変形」ができるようになりました。

    PowerPoint 2016で新しい画面切り替え効果「変形」が追加さ…

コメント

  • コメント (0)

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

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

Time limit is exhausted. Please reload CAPTCHA.

Translate

Chinese (Simplified)Chinese (Traditional)EnglishFrenchGermanJapaneseKoreanRussianSpanish

最近の記事

アーカイブ

PAGE TOP