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

















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