Office関連

外部アプリケーションのコンボボックスの内容を取得するVBAマクロのサンプル

Q&Aサイトに下記質問がありました。
(この質問も何となく似たような感じの内容です。)

上記サイトのアカウントは持っていないので回答を付けることはできませんが、私のブログ記事を参照していただいているようなので、この場でサンプルコードを載せてみようかと思います。
例として、メモ帳のフォントダイアログにある「文字セット」コンボボックスの内容の取得を試されているので、同じ処理のマクロを書いてみます。

※下記コードはエラー処理していませんので、場合によってはループが止まらなくなる可能性があります。

'32ビット版Officeを対象
Option Explicit

Private Declare Function FindWindowEx Lib "user32" Alias "FindWindowExA" (ByVal hWndParent As Long, ByVal hWndChildAfter As Long, ByVal lpszClass As String, ByVal lpszWindow As String) As Long
Private Declare Function PostMessage Lib "user32" Alias "PostMessageA" (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long

Private Const WM_CLOSE = &H10
Private Const WM_COMMAND As Long = &H111

Public Sub Sample()
'メモ帳のフォントダイアログにある「文字セット」コンボボックスの内容取得
  Dim uiAuto As CUIAutomation
  Dim elmFontDlg As IUIAutomationElement
  Dim elmCharSetCbo As IUIAutomationElement
  Dim elmCharSetLCbo As IUIAutomationElement
  Dim ecptn As IUIAutomationExpandCollapsePattern
  Dim cndListItems As IUIAutomationCondition
  Dim aryListItems As IUIAutomationElementArray
  Dim hNotepad As Long
  Dim hFontDlg As Long
  Dim i As Long
  
  Set uiAuto = New CUIAutomation
  
  'メモ帳取得
  Shell "notepad.exe", vbNormalFocus
  Do
    hNotepad = FindWindowEx(0, 0, "Notepad", vbNullString)
    DoEvents
  Loop Until hNotepad <> 0
  
  'フォントダイアログ取得
  PostMessage hNotepad, WM_COMMAND, &H21, 0 'フォントダイアログ表示
  Do
    hFontDlg = FindWindowEx(0, 0, "#32770", "フォント")
    DoEvents
  Loop Until hFontDlg <> 0
  Set elmFontDlg = uiAuto.ElementFromHandle(ByVal hFontDlg)
  If elmFontDlg Is Nothing Then Exit Sub
  
  '文字セットコンボボックス取得→オープン
  Do
    Set elmCharSetCbo = GetElement(uiAuto, _
                                   elmFontDlg, _
                                   UIA_AccessKeyPropertyId, _
                                   "Alt+r", _
                                   UIA_ComboBoxControlTypeId)
    DoEvents
  Loop While elmCharSetCbo Is Nothing
  Set ecptn = elmCharSetCbo.GetCurrentPattern(UIA_ExpandCollapsePatternId)
  ecptn.Expand
  
  '文字セットコンボボックス内容列挙→クローズ
  Do
    Set elmCharSetLCbo = GetElement(uiAuto, _
                                    elmCharSetCbo, _
                                    UIA_ClassNamePropertyId, _
                                    "ComboLBox")
    DoEvents
  Loop While elmCharSetLCbo Is Nothing
  Set cndListItems = uiAuto.CreatePropertyCondition( _
                       UIA_ControlTypePropertyId, _
                       UIA_ListItemControlTypeId _
                     )
  Set aryListItems = elmCharSetLCbo.FindAll( _
                       TreeScope_Subtree, _
                       cndListItems _
                     )
  For i = 0 To aryListItems.Length - 1
    Debug.Print aryListItems.GetElement(i).CurrentName
  Next
  ecptn.Collapse
  
  'フォントダイアログを閉じてメモ帳終了
  PostMessage hFontDlg, WM_CLOSE, 0, 0
  PostMessage hNotepad, WM_CLOSE, 0, 0
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

質問されている方はUIAutomation→IAccessibleでの処理を行われていますが、コンボボックスを一度展開すれば、UIAutomationでも内容を取得することができました。

あるいは、IAccessibleだけを使って、下記のように処理しても良いかもしれません。

'32ビット版Officeを対象
Option Explicit

Private Declare Function AccessibleChildren Lib "oleacc" (ByVal paccContainer As IAccessible, ByVal iChildStart As Long, ByVal cChildren As Long, ByRef rgvarChildren As Any, ByRef pcObtained As Long) As Long
Private Declare Function AccessibleObjectFromWindow Lib "oleacc" (ByVal hWnd As Long, ByVal dwId As Long, riid As Any, ByRef ppvObject As IAccessible) As Long
Private Declare Function FindWindowEx Lib "user32" Alias "FindWindowExA" (ByVal hWndParent As Long, ByVal hWndChildAfter As Long, ByVal lpszClass As String, ByVal lpszWindow As String) As Long
Private Declare Function IIDFromString Lib "ole32" (ByVal lpsz As Long, lpiid As Any) As Long
Private Declare Function PostMessage Lib "user32" Alias "PostMessageA" (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long

Private Const CHILDID_SELF = &H0&
Private Const OBJID_CLIENT = &HFFFFFFFC
Private Const ROLE_SYSTEM_LIST = &H21
Private Const WM_CLOSE = &H10
Private Const WM_COMMAND As Long = &H111

Public Sub Sample2()
'メモ帳のフォントダイアログにある「文字セット」コンボボックスの内容取得
  Dim hNotepad As Long
  Dim hFontDlg As Long
  Dim accFontDlg As IAccessible
  Dim accCharSetLst As IAccessible
  Dim IID(0 To 3) As Long
  Dim i As Long
  
  'メモ帳取得
  Shell "notepad.exe", vbNormalFocus
  Do
    hNotepad = FindWindowEx(0, 0, "Notepad", vbNullString)
    DoEvents
  Loop Until hNotepad <> 0
  
  'フォントダイアログ取得
  PostMessage hNotepad, WM_COMMAND, &H21, 0 'フォントダイアログ表示
  Do
    hFontDlg = FindWindowEx(0, 0, "#32770", "フォント")
    DoEvents
  Loop Until hFontDlg <> 0
  IIDFromString StrPtr("{618736E0-3C3D-11CF-810C-00AA00389B71}"), IID(0) 'IID_IAccessible
  AccessibleObjectFromWindow hFontDlg, OBJID_CLIENT, IID(0), accFontDlg
  If accFontDlg Is Nothing Then Exit Sub
  
  'コンボボックス取得→内容列挙
  Set accCharSetLst = GetAccessibleObject(accFontDlg, _
                                          "文字セット(R):", _
                                          ROLE_SYSTEM_LIST)
  If accCharSetLst Is Nothing Then Exit Sub
  For i = 1 To accCharSetLst.accChildCount
    Debug.Print accCharSetLst.accName(i&)
  Next
  
  'フォントダイアログを閉じてメモ帳終了
  PostMessage hFontDlg, WM_CLOSE, 0, 0
  PostMessage hNotepad, WM_CLOSE, 0, 0
End Sub

Private Function GetAccessibleObject(ByVal SrcAccObj As IAccessible, _
                                     ByVal TgtAccName As String, _
                                     ByVal TgtAccRole As Long) As IAccessible
  Dim ret As IAccessible
  Dim list() As Variant
  Dim cnt As Long, i As Long
  
  Set ret = Nothing '初期化
  If (SrcAccObj.accName(CHILDID_SELF) = TgtAccName) And _
     (SrcAccObj.accRole(CHILDID_SELF) = TgtAccRole) Then
    Set ret = SrcAccObj
  Else
    cnt = SrcAccObj.accChildCount
    If cnt > 0 Then
      ReDim list(cnt - 1)
      If AccessibleChildren(SrcAccObj, 0, cnt, list(0), cnt) = 0 Then
        For i = LBound(list) To UBound(list)
          If TypeOf list(i) Is IAccessible Then
            Set ret = GetAccessibleObject(list(i), TgtAccName, TgtAccRole)
            If Not ret Is Nothing Then Exit For
          End If
        Next
      End If
    End If
  End If
  Set GetAccessibleObject = ret
End Function

いずれにしても、ここで挙げたコードはほんの一例ですので、対象となるアプリケーションが違えば処理も異なってきます。
大切なのは、Inspect等のツールを使って、対象となる要素がどのような構造になっているのかをよく見ることだと思います。

また、外部アプリケーションの操作をVBAマクロでやろうとすると、処理が複雑になることが多いので、“VBAにそんな無理はさせない!手動でできるところは手動でやる!!”というように、処理を切り分けることも考えてみてはいかがでしょうか。

指定したファイルをエクスプローラーで開いて選択するVBAマクロ前のページ

ハードオフでジャンク品のポケモンパールを買ってきたよ。次のページ

関連記事

  1. Office関連

    WordBasicマクロの資料

    Word 97でVBA機能が搭載される以前のWordでは、WordBa…

  2. Office関連

    指定したセル範囲をUTF-8やEUC-JP等のテキストファイルとして出力するExcelアドイン

    以前この記事で、指定したセル範囲をUTF-8やEUC-JP等のテキスト…

  3. Office関連

    「VBA質問箱」にアクセスできない。

    2013/03/19 追記:ドメインが更新されVBA質問箱が閲覧で…

  4. Office関連

    Computer Vision APIを使って画像から文字列を取得するVBAマクロ

    前々回の記事で、Fiddlerを使ってMicrosoft Cognit…

  5. Office関連

    SendKeysでWindowsキーを送信するVBAマクロ

    「VBA SendKeys Windowsキー」といったキーワード検索…

コメント

  • コメント (3)

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

    • nux5
    • 2017年 10月 25日 12:31am

    teratail で質問した本人です。

    お礼遅くなりまして、申し訳ありません。
    おかげさまで、実施したい事ができました。

    ありがとうございました。

    別件で、PostMessage について、質問させてください。

    >PostMessage hNotepad, WM_COMMAND, &H21, 0 ‘フォントダイアログ表示

    きぬあささんは、メニューアイテム、コントロール、アクセラレーターの ID は、どの様に取得されたか、教えて頂けないでしょうか。

    PostMessage を使用したことがなく、ネットで調べたところ、&H21 で、フォントダイアログを起動している様なのがわかり、
    Resource Hacker と言うツールで取得できると、別のサイトで見かけ、そこで説明されていた様に notepad.exe を開いてみたのですが、MENUがなく取得できませんでした。

    • > nux5様

      無事に解決されたとのことで何よりです。

      > メニューアイテム、コントロール、アクセラレーターの ID は、どの様に取得されたか、教えて頂けないでしょうか。

      今回の場合のように特定のアプリケーション(ウィンドウ)に対してどのようなメッセージが発行されたかを調べる場合、私は「Spy++」を使用しています。

      ・Spy++ の概要
      https://msdn.microsoft.com/ja-jp/library/dd460756.aspx

      Visual Studio付属のツールですが、Internet Archiveかどこかからダウンロードできたような…。
      (リンク先は忘れてしまいました。すみません。)

      > Resource Hacker と言うツールで取得できる

      Resource Hackerは文字通り、実行ファイルやDLLファイル等のリソースを見たり修正したりするソフトですので、今回のようなアプリケーションの動作を調べる場合には適していないツールです。

      実行ファイルが持っているアイコンやダイアログを調べる際には便利なツールですので、そういった機会があればお使いください。

    • nux5
    • 2017年 10月 25日 7:35pm

    きぬあささん、
    探してみます。

    ありがとうございました。

Time limit is exhausted. Please reload CAPTCHA.

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

Translate

最近の記事

アーカイブ

PAGE TOP