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