none
Excel2016 「PERSONAL.XLSB」VBAからVBEを操作する(開く)

    質問

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


    u793nabe




    • 編集済み u793nabe 2018年2月21日 15:37
    2018年2月21日 15:26

回答

  • 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!)

    • 回答としてマーク u793nabe 2018年2月22日 15:18
    2018年2月21日 23:37

すべての返信

  • 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!)

    • 回答としてマーク u793nabe 2018年2月22日 15:18
    2018年2月21日 23:37
  • 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







    • 編集済み u793nabe 2018年2月26日 9:12
    2018年2月22日 15:17