トップ回答者
Excel2016 「PERSONAL.XLSB」VBAからVBEを操作する(開く)

質問
回答
-
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
すべての返信
-
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
-
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