Office関連

VBAプロジェクトを「展開する」VBAマクロ

MSDNフォーラム面白い質問がありました。
VBE・プロジェクト エクスプローラーにある指定したプロジェクトをマクロで“展開”したい(「+」ボタンをクリック)、というものです。

マクロでこの作業を行う必要性が本当にあるのかどうかは私には分かりませんが、とりあえずコードを書いてみることにしました。

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

Public Sub Sample()
  ExpandVbaProject "ExpandVbaProject", False
End Sub

Private Sub ExpandVbaProject(ByVal ProjectName As String, _
                             Optional ByVal ExpandState As Boolean = True)
  Dim uiAuto As CUIAutomation
  Dim elmVbeWindow As IUIAutomationElement
  Dim elmPjWindow As IUIAutomationElement
  Dim elmSysTree As IUIAutomationElement
  Dim aryTreeItems As IUIAutomationElementArray
  Dim ptnExpand As IUIAutomationExpandCollapsePattern
  Dim hVbeWindow As LongPtr
  Dim w As Object 'VBIDE.Window
  Dim i As Long
  Const vbext_wt_ProjectWindow = 6
  
  Application.CommandBars.FindControl(ID:=1695).Execute 'VBE表示
  On Error Resume Next
  hVbeWindow = Application.VBE.MainWindow.Hwnd
  Select Case Err.Number
    Case 1004, 6068, -2147188160
      MsgBox "[セキュリティ センターの設定]から" & vbNewLine & vbNewLine & _
             "【VBA プロジェクト オブジェクト モデルへのアクセスを信頼する】" & vbNewLine & vbNewLine & _
             "にチェックを入れた後、再度マクロを実行してください。", vbExclamation + vbSystemModal
      Exit Sub
  End Select
  On Error GoTo 0
  
  'プロジェクト エクスプローラー表示
  For Each w In Application.VBE.Windows
    If w.Type = vbext_wt_ProjectWindow Then
      w.Visible = True
      Exit For
    End If
  Next
  
  Set uiAuto = New UIAutomationClient.CUIAutomation
  Set elmVbeWindow = uiAuto.ElementFromHandle(ByVal hVbeWindow)
  If elmVbeWindow Is Nothing Then Exit Sub
  Set elmPjWindow = GetElement(uiAuto, _
                               elmVbeWindow, _
                               UIA_ClassNamePropertyId, _
                               "PROJECT", _
                               UIA_PaneControlTypeId)
  If elmPjWindow Is Nothing Then Exit Sub
  Set elmSysTree = GetElement(uiAuto, _
                              elmPjWindow, _
                              UIA_ClassNamePropertyId, _
                              "SysTreeView32", _
                              UIA_TreeControlTypeId)
  If elmSysTree Is Nothing Then Exit Sub
  Set aryTreeItems = elmSysTree.FindAll(TreeScope_Children, _
                                        uiAuto.CreatePropertyCondition( _
                                          UIA_ControlTypePropertyId, _
                                          UIA_TreeItemControlTypeId _
                                        ))
  If aryTreeItems.Length < 1 Then Exit Sub
  For i = 0 To aryTreeItems.Length - 1
    If InStr(LCase(aryTreeItems.GetElement(i).CurrentName), LCase(ProjectName)) Then
      Set ptnExpand = aryTreeItems.GetElement(i) _
                      .GetCurrentPattern(UIA_ExpandCollapsePatternId)
      If ExpandState = True Then
        ptnExpand.Expand
      Else
        ptnExpand.Collapse
      End If
      Exit For
    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

gekka氏がすでにスレッドに挙げられているコードとほぼ同じ内容ですが、WordやPowerPointでも動作するようにしています。

ExpandVbaProjectプロシージャーの第一引数でプロジェクト名を、第二引数で展開するかたたむかを指定しているわけですが、上で書いた通り需要はかなり謎なマクロだと思います。

[Officeアドイン]組み込みのワークシート関数を呼び出す方法前のページ

Windows Insider Meetup in Japan 3 東京に参加しました。次のページ

関連記事

  1. Office関連

    表示モードを変更するPowerPointマクロ

    PowerPointには様々な表示モードがありますが、私のお気に入りは…

  2. Office関連

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

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

  3. Office関連

    2つの文書を比較するWordマクロ

    先日テキスト比較ソフトの「ちゃうちゃう!」がバージョンアップされたこと…

  4. Office関連

    ExcelとPowerPointに自動保存機能が追加されました。

    Excel 2016を使っていて、ふと気が付いたのが画面左上にある「自…

  5. Office関連

    古い形式のWordテンプレートを新しい形式に一括変換するVBScript

    古い形式のWordテンプレート(dot)を新しい形式(dotx,dot…

  6. Office関連

    Office製品の開発チームにユーザーの声を届けよう!

    Office 用アプリやSharePoint 用アプリを開発する際「こ…

コメント

  • コメント (0)

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

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

Time limit is exhausted. Please reload CAPTCHA.

※本ページはプロモーションが含まれています。

Translate

最近の記事

アーカイブ

PAGE TOP