Excel2016 ｢PERSONAL.XLSB｣VBAからVBEを操作する(開く)

Question

個人用マクロブック｢PERSONAL.XLSB｣のVBAから、VBE｢プロジェクトエクスプローラー｣内の｢xxBook1.xlsm｣の[+]をクリックする(開く)コードを知りたいのですが、ご教授よろしくお願いいたします。

---

u793nabe

Answer 1

UIAutomationClientとMicrosoft Visual Basic for Applications Extensiblilityを参照して

Option Explicit

Sub Test()
    Call ExpandProjectTree(Application.Workbooks.item(1), False)
    MsgBox "TEST"
    Call ExpandProjectTree(Application.Workbooks.item(1), True)
End Sub

Sub ExpandProjectTree(ByVal wb As Workbook, ByVal expand As Boolean)
    Application.VBE.MainWindow.Visible = True
    Dim w As VBIDE.Window
    For Each w In Application.VBE.Windows
        If (w.Type = vbext_wt_ProjectWindow) Then
            w.Visible = True
            Exit For
        End If
    Next

    If (w Is Nothing) Then
        Exit Sub
    End If

    Dim hwnd As LongPtr
    hwnd = w.hwnd
    Dim uia As UIAutomationClient.CUIAutomation
    Dim wndIDE As UIAutomationClient.IUIAutomationElement
    Dim wndProj As UIAutomationClient.IUIAutomationElement
    Dim eTree As UIAutomationClient.IUIAutomationElement
    Set uia = New UIAutomationClient.CUIAutomation
    Dim con As UIAutomationClient.IUIAutomationPropertyCondition

    Set con = uia.CreatePropertyCondition(UIA_PropertyIds.UIA_NativeWindowHandlePropertyId, Application.VBE.MainWindow.hwnd)
    Set wndIDE = uia.GetRootElement().FindFirst(TreeScope_Children, con)

    Set con = uia.CreatePropertyCondition(UIA_PropertyIds.UIA_ClassNamePropertyId, "PROJECT")
    Set wndProj = wndIDE.FindFirst(TreeScope_Subtree, con)

    Set con = uia.CreatePropertyCondition(UIA_PropertyIds.UIA_ControlTypePropertyId, UIA_ControlTypeIds.UIA_TreeControlTypeId)
    Set eTree = wndProj.FindFirst(TreeScope_Subtree, con)

    Set con = uia.CreatePropertyCondition(UIA_PropertyIds.UIA_ControlTypePropertyId, UIA_ControlTypeIds.UIA_TreeItemControlTypeId)
    Dim ar As UIAutomationClient.IUIAutomationElementArray
    Set ar = eTree.FindAll(TreeScope_Children, con)
    Dim i As Integer
    For i = 0 To ar.Length - 1
        Dim item As UIAutomationClient.IUIAutomationElement
        Set item = ar.GetElement(i)

        Dim x As String
        x = "(" & wb.Name & ")"
        If (InStr(item.CurrentName, x) > 0) Then
            Debug.Print item.CurrentName

            Dim ex As UIAutomationClient.IUIAutomationExpandCollapsePattern
            Set ex = item.GetCurrentPattern(UIA_PatternIds.UIA_ExpandCollapsePatternId)
            If (expand) Then
                ex.expand
            Else
                ex.Collapse
            End If

        End If
    Next
End Sub

---

個別に明示されていない限りgekkaがフォーラムに投稿したコードにはフォーラム使用条件に基づき「MICROSOFT LIMITED PUBLIC LICENSE」が適用されます。(かなり自由に使ってOK!)

Answer 2

gekkaさん早々のご回答ありがとうございました。
≪試行結果≫
VBプロジェクトツリーを展開する件(成功)…感謝
UIAutomationClientとMicrosoft Visual Basic for Applications Extensiblilityを参照設定する件。
※VBAProject(PRIVATE.XLSB)から運用する場合はターゲットがリストボックスに表示されないので手動で[参照]する必要がありターゲットを特定するのに非力にて悪戦苦闘。…追記:ターゲットはリストボックスに在りました（昇順に並んでると思い込み的外れのヶ所に目線がいき見つけれなかっただけでした）。
C:\Windows\SysWOW64\UIAutomationCore.dll
C:\Program Files (x86)\Common Files\Microsoft Shared\VBA\VBA6\VBE6EXT.OLB

※VBプロジェクトツリーを展開する構文は当方の運用目的に合うよう｢Sub Test()｣のコードを変更して試行しました。
本運用は、｢Call ExpandProjectTree(ActiveWorkbook, True)｣を呼ぶ側に記述して活用したいと思います。
Sub Test()
   'Call ExpandProjectTree(ActiveWorkbook, False) '閉じる
    Call ExpandProjectTree(ActiveWorkbook, True)  '開く
End Sub
以上

---

u793nabe