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関連

    Office文書をパスワード付きPDFに変換するVBAマクロ

    4年ほど前に書いた、下記記事のマクロがWordでも使えるか?との質問を…

  2. アイコン一覧

    Office 2013 アイコン一覧(X,Y,Z)

    ・Office 2013 アイコン一覧 NUM…

  3. Office関連

    Excel 2013 新関数一覧

    「関数一覧(Excel 2010)」と「関数一覧(Excel 2013…

  4. Office関連

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

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

  5. Word

    Word マクロ参考本の私的感想&評価まとめ

    私は趣味でWord マクロを書くことが多く、関連書籍も何冊か所持してい…

コメント

  • コメント (0)

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

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

Time limit is exhausted. Please reload CAPTCHA.

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

Translate

最近の記事

アーカイブ

PAGE TOP