Office関連

VBAプロジェクトを「展開する」VBAマクロ

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

[Officeアドイン]組み込みのワークシート関数を呼び出す方法前のページ

Windows Insider Meetup in Japan 3 東京に参加しました。次のページ

関連記事

  1. Office関連

    テンプレートから簡単に新規文書を作成できるようにするWordテンプレート

    Wordで自作のテンプレートを利用して文書を作成するとき、2007以降…

  2. Office関連

    PhpSpreadsheetを使ってPHPからExcelファイルを出力してみる。

    一年半ほど前、「PHPWord」を使ってPHPからWordファイルを出…

  3. Office関連

    Excel REST APIをPowerShellから呼び出す方法

    以前Excel REST APIをVBAから呼び出す方法を紹介しました…

  4. アイコン一覧

    Office 2013 アイコン一覧(G)

    ・Office 2013 アイコン一覧 NUM…

  5. Office関連

    VBAから扱えるDLLをC#で書いてみる。

    以前書いた記事でSharpDevelopを使ってExcel用のCOMア…

コメント

  • コメント (0)

  • トラックバックは利用できません。

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

Time limit is exhausted. Please reload CAPTCHA.

※本ページはプロモーションが含まれています。

Translate

最近の記事

アーカイブ

PAGE TOP