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 2013にも対応させる。

    ※ この情報はOffice 2013 カスタマー プレビュー版を元にし…

  2. Office アドイン

    [Office用アプリ]ユーザー設定を保存する。

    ※ この情報はOffice 2013 カスタマー プレビュー版を元にし…

  3. アイコン一覧

    Office 365アイコン(imageMso)一覧(A)

    Office 365のデスクトップ版Officeアプリケーション(Wo…

  4. Office関連

    Outlook REST APIに会議室情報を取得するAPIが追加されました。

    松崎さんのツイートで、Outlook REST APIのベータエンドポ…

コメント

  • コメント (0)

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

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

Time limit is exhausted. Please reload CAPTCHA.

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

Translate

最近の記事

アーカイブ

PAGE TOP