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

関連記事

  1. Office関連

    【2017年1月版】Microsoft Edgeを操作するVBAマクロ(DOM編)

    「Microsoft Edge VBA 操作」こういったキーワード検索…

  2. Office アドイン

    [Office用アプリ]販売者ダッシュボードが日本語化されました。

    当ブログでも下記ページなどで紹介しているSeller Dashboar…

  3. Office アドイン

    Office 用アプリの開発資料(日本語)が公開されました。

    Office 用アプリの開発資料(日本語)が公開されました。・…

  4. Office関連

    「傍点をふる」をWord 2007/2010で簡単に使う方法

    Wordで文字列を強調したいときに便利なのが「傍点をふる」コマンド。…

  5. Office関連

    Word 2013では簡単にウィンドウ ハンドルを取得できるようになりました。

    ※ この情報はOffice 2013 カスタマー プレビュー版を元にし…

  6. Office関連

    Excel 2016でUTF-8のCSVファイルがサポートされるようになりました。

    Office 2016の10月の機能更新によって、ExcelでUTF-…

コメント

  • コメント (0)

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

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

Time limit is exhausted. Please reload CAPTCHA.

最近の記事

アーカイブ

RapidSSL_SEAL-90x50
PAGE TOP