Q&Aサイトに下記質問がありました。
(この質問も何となく似たような感じの内容です。)
- Excel, VBA, UI Automation を使用して、コンボボックス内の選択肢をすべてを取得
- https://teratail.com/questions/93907
上記サイトのアカウントは持っていないので回答を付けることはできませんが、私のブログ記事を参照していただいているようなので、この場でサンプルコードを載せてみようかと思います。
例として、メモ帳のフォントダイアログにある「文字セット」コンボボックスの内容の取得を試されているので、同じ処理のマクロを書いてみます。
※下記コードはエラー処理していませんので、場合によってはループが止まらなくなる可能性があります。
'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にそんな無理はさせない！手動でできるところは手動でやる！！”というように、処理を切り分けることも考えてみてはいかがでしょうか。
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ファイル等のリソースを見たり修正したりするソフトですので、今回のようなアプリケーションの動作を調べる場合には適していないツールです。
実行ファイルが持っているアイコンやダイアログを調べる際には便利なツールですので、そういった機会があればお使いください。
きぬあささん、
探してみます。
ありがとうございました。