【VBA】UIAutomationで業務改善5

目次

EdgeのCombobox操作

alone in my room寒くなってきたね♪手足が冷え冷えのjimです。ども✋

最近、VBAマクロのブラウザ操作の改修（IE⇒Edge）やってて、Combobox（Edge）の操作でハマったので記事にします😥

Comboboxの一覧を表示させることはできるのですが、UIAutomationで一覧の情報を選択できないという。。。

そして、ググると自分の記事がアホみたいに出てくるという。。。

ちなみに、まだUIAutomationで操作できてません。別の方法を紹介します。

とりあえず、前回の記事のようにEdgeの要素を取得（edgeElementのこと）したところから。

以下のようにしてやれば、Comboboxの一覧を表示させることが出来ます。アクティブウィンドウがVBEに切り替わると消えちゃうんですけどね。

1С (Запрос)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
Option Explicit
Sub combobox()
Dim shellObject As Object
Dim uiAuto As UIAutomationClient.CUIAutomation
Dim edgeElement As IUIAutomationElement
Dim comboboxElement As IUIAutomationElement
Dim expandPattern As IUIAutomationExpandCollapsePattern
    Set shellObject = CreateObject("Shell.Application")
    shellObject.ShellExecute "https://www.youtube.com/"
    Set uiAuto = New UIAutomationClient.CUIAutomation
    Set edgeElement = GetEdge(uiAuto)
    '待機処理は無視でーす
    '例えばダウンロードの拡張子を選択する場合で _
     Comboboxの名前が『* エクスポートファイルの形式』の場合
    Set comboboxElement = _
    GetElement(uiAuto, edgeElement, UIA_NamePropertyId, _
        "* エクスポートファイルの形式", UIA_ComboBoxControlTypeId)
    Set expandPattern = comboboxElement.GetCurrentPattern(UIA_ExpandCollapsePatternId)
    expandPattern.Expand
End Sub
Function GetElement(ByVal uiAuto As UIAutomationClient.CUIAutomation, ByVal edgeElement As IUIAutomationElement, _
ByVal propertyId As Long, ByVal propertyString As String, Optional ByVal propertyType As Long = 0)
Dim Cond1 As IUIAutomationCondition
Dim Cond2 As IUIAutomationCondition
    Set Cond1 = uiAuto.CreatePropertyCondition(propertyId, propertyString)
    Set Cond2 = uiAuto.CreatePropertyCondition(UIA_ControlTypePropertyId, propertyType)
    Set Cond1 = uiAuto.CreateAndCondition(Cond1, Cond2)
    Set GetElement = edgeElement.FindFirst(TreeScope_Subtree, Cond1)
End Function
Function GetEdge(ByVal uiAuto As UIAutomationClient.CUIAutomation)
Dim allElement As IUIAutomationElement
Dim condControls As UIAutomationClient.IUIAutomationCondition
Dim arryControls As UIAutomationClient.IUIAutomationElementArray
Dim i As Long
    Set allElement = uiAuto.GetRootElement
    Set condControls = uiAuto.CreatePropertyCondition(UIA_ControlTypePropertyId, UIA_WindowControlTypeId)
    Set arryControls = allElement.FindAll(TreeScope_Subtree, condControls)
    For i = 0 To arryControls.Length - 1
        If LCase(arryControls.GetElement(i).CurrentName) Like "*- microsoft? edge" And _
            arryControls.GetElement(i).CurrentClassName = "Chrome_WidgetWin_1" Then
            Set GetEdge = arryControls.GetElement(i)
            Exit For
        End If
    Next
End Function

一覧は表示されます。

でも、できないのよ。これから先の操作が。。

Edgeじゃなければ出来るぽいんだけど。。。

 

PostMessage

仕方ないからキー操作。しばらくはコレだね。

一度、Comboboxの一覧を開けば、一覧が閉じてもキー操作が利くみたいなのね。Comboboxがアクティブになるので、比較的扱いやすいかなって思ってます。UIAutomationで要素取得しながら制御文で何とかなりそう。

一応、『expandPattern.Expand』でウィンドウが最前面にくるのでSendkeysでもいけるかもしれないけど、なるだけ確実に操作したいのでEdgeのハンドルにキーを送信。

↓まず、Edgeのハンドルを取得します。

1С (Запрос)
1
2
3
4
Sub combobox2()
Dim myNum As Long
    myNum = edgeElement.GetCurrentPropertyValue(UIA_NativeWindowHandlePropertyId)
End Sub

↓そして、Edgeのハンドルに上キーを送ります。

1С (Запрос)
1
2
3
4
5
6
7
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
Sub combobox3()
Dim myNum As Long
    myNum = edgeElement.GetCurrentPropertyValue(UIA_NativeWindowHandlePropertyId)
    PostMessage myNum, &H100, 38, 0
End Sub

キーを押すってのが『&H100』です。KEYDOWNみたいな感じで定数にしておいた方が読みやすいと思います。←やれよ

ちなみに、これだけだと押した状態がキープされた気がする。UPも作った方がいいかも。。

上キーが『38』です。キーコードですね。これも定数にした方がいいかも。←やれよ

ウーン！ってすると。。。

1С (Запрос)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
Option Explicit
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
Sub combobox()
Dim shellObject As Object
Dim uiAuto As UIAutomationClient.CUIAutomation
Dim edgeElement As IUIAutomationElement
Dim comboboxElement As IUIAutomationElement
Dim expandPattern As IUIAutomationExpandCollapsePattern
Dim myNum As Long
    Set shellObject = CreateObject("Shell.Application")
    shellObject.ShellExecute "https://www.youtube.com/"
    Set uiAuto = New UIAutomationClient.CUIAutomation
    Set edgeElement = GetEdge(uiAuto)
    '待機処理は無視でーす
    '例えばダウンロードの拡張子を選択する場合で _
     Comboboxの名前が『* エクスポートファイルの形式』の場合
    Set comboboxElement = _
    GetElement(uiAuto, edgeElement, UIA_NamePropertyId, _
        "* エクスポートファイルの形式", UIA_ComboBoxControlTypeId)
    Set expandPattern = comboboxElement.GetCurrentPattern(UIA_ExpandCollapsePatternId)
    expandPattern.Expand
    myNum = edgeElement.GetCurrentPropertyValue(UIA_NativeWindowHandlePropertyId)
    PostMessage myNum, &H100, 38, 0
    PostMessage myNum, &H100, 13, 0
End Sub
Function GetElement(ByVal uiAuto As UIAutomationClient.CUIAutomation, ByVal edgeElement As IUIAutomationElement, _
ByVal propertyId As Long, ByVal propertyString As String, Optional ByVal propertyType As Long = 0)
Dim Cond1 As IUIAutomationCondition
Dim Cond2 As IUIAutomationCondition
    Set Cond1 = uiAuto.CreatePropertyCondition(propertyId, propertyString)
    Set Cond2 = uiAuto.CreatePropertyCondition(UIA_ControlTypePropertyId, propertyType)
    Set Cond1 = uiAuto.CreateAndCondition(Cond1, Cond2)
    Set GetElement = edgeElement.FindFirst(TreeScope_Subtree, Cond1)
End Function
Function GetEdge(ByVal uiAuto As UIAutomationClient.CUIAutomation)
Dim allElement As IUIAutomationElement
Dim condControls As UIAutomationClient.IUIAutomationCondition
Dim arryControls As UIAutomationClient.IUIAutomationElementArray
Dim i As Long
    Set allElement = uiAuto.GetRootElement
    Set condControls = uiAuto.CreatePropertyCondition(UIA_ControlTypePropertyId, UIA_WindowControlTypeId)
    Set arryControls = allElement.FindAll(TreeScope_Subtree, condControls)
    For i = 0 To arryControls.Length - 1
        If LCase(arryControls.GetElement(i).CurrentName) Like "*- microsoft? edge" And _
            arryControls.GetElement(i).CurrentClassName = "Chrome_WidgetWin_1" Then
            Set GetEdge = arryControls.GetElement(i)
            Exit For
        End If
    Next
End Function

あ、『13』はエンターね。

キーコードはググれば出てくると思います。

一応、自分でも簡単に調べる事ができるので、この記事で紹介しておきます。

 

キーコード

UserFormのボタンに『KeyDown』というイベントがあります。

このイベントはボタンがアクティブの時、押下されたキーコードを取得できるものです。（API使う方法もある）

ユーザーフォームを挿入してコマンドボタンを置き、ユーザーフォームに以下のコードを書いてみましょう。

1С (Запрос)
1
2
3
Private Sub CommandButton1_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
    Debug.Print KeyCode
End Subゆ

ユーザーフォームを開いて上キーを叩くと、イミディエイトウィンドウに38が表示されるはずです。

つまりは、、、そゆこと。

ExcelのワークシートにActiveXのコマンドボタン置いても同じことができると思います。

 

 

はい。そゆ感じで、UIAutomationで全て操作できてないっていう😅

これから色々と大変かも。。。

疲れるぅ～😣

ってことで、またねぇ✋

 

まとめ

【VBA】UIAutomationで業務改善１

【VBA】UIAutomationで業務改善２

【VBA】UIAutomationで業務改善３

【VBA】UIAutomationで業務改善4

関連記事

ハンドルからメッセージの取得⇒

【VBA】SendMessageで文字列を取得

VBA,プログラミング,仕事,現在の仕事VBA,仕事

Posted by jim