HOME > Q&A; > Excel （VBA）

Excel （VBA）
Excel VBAに関するフォーラムです。
  • 掲示板への投稿には会員登録（無料）が必要です。会員登録がまだの方はこちら
  • 「掲示板ご利用上のお願い」に反するご記入はご遠慮ください。
  • Q&A;掲示板の使い方はこちらをご覧ください
トピックに返信
質問

 
(Windows 8 Pro : Excel 2013)
Re: UI Automationでの検索
投稿日時: 13/03/21 05:54:03
投稿者: yayadon

kumatti さんへ
 
UIA_NamePropertyId は，それぞれ
 
・デスクトップ項目
・フォント サイズ
 
のようです。
 
 
UIA_AutomationIdPropertyId でやるならば
 
・DesktopElementCombobox
・FontSizeCombobox
 
 
# Win8 64bit & Excel 2013 32bit or VS2012 C++ で確認してます。
 
※ UIAutomationClient に参照設定。 

Option Explicit

Private Declare PtrSafe Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As LongPtr


Sub hoge()

    Dim hwnd As LongPtr
    Dim iUIA2 As IUIAutomation2
    Dim iElemTop As IUIAutomationElement
    Set iUIA2 = New CUIAutomation8

    hwnd = FindWindow("CabinetWClass", "ディスプレイ")
    If hwnd = 0 Then Exit Sub
    Set iElemTop = iUIA2.ElementFromHandle(ByVal hwnd)
    
    Dim iCnd As IUIAutomationCondition
    Set iCnd = iUIA2.CreatePropertyCondition(UIA_NamePropertyId, "デスクトップ項目")

    Dim iElemFound As IUIAutomationElement
    Set iElemFound = iElemTop.FindFirst(TreeScope_Subtree, iCnd)
    If Not iElemFound Is Nothing Then
        Dim iValuePattern As IUIAutomationValuePattern
        Set iValuePattern = iElemFound.GetCurrentPattern(UIA_ValuePatternId)
        MsgBox iValuePattern.CurrentValue
    End If

End Sub

　
 
　

投稿日時: 13/03/21 07:19:23
投稿者: yayadon

コンボボックスを列挙するほうは，以下のような感じだと思います。
 
 

Sub hoge2()

    Dim hwnd As LongPtr
    hwnd = FindWindow("CabinetWClass", "ディスプレイ")
    If hwnd = 0 Then Exit Sub

    Dim iUIA2 As IUIAutomation2
    Set iUIA2 = New CUIAutomation8

    Dim iElemTop As IUIAutomationElement
    Set iElemTop = iUIA2.ElementFromHandle(ByVal hwnd)
    
    Dim iCnd As IUIAutomationCondition
    Set iCnd = iUIA2.CreatePropertyCondition(UIA_ControlTypePropertyId, _
                                             UIA_ComboBoxControlTypeId)

    Dim iElemArray As IUIAutomationElementArray
    Set iElemArray = iElemTop.FindAll(TreeScope_Subtree, iCnd)
    
    If Not iElemArray Is Nothing Then
        Dim i As Long
        For i = 0 To iElemArray.Length - 1
            Dim iElemFound As IUIAutomationElement
            Set iElemFound = iElemArray.GetElement(i)
            Dim iValuePattern As IUIAutomationValuePattern
            Set iValuePattern = iElemFound.GetCurrentPattern(UIA_ValuePatternId)
            MsgBox iElemFound.CurrentName & ": " & iValuePattern.CurrentValue
        Next
    End If

End Sub

　

回答
投稿日時: 13/03/21 07:30:14
投稿者: kumatti
投稿者のウェブサイトに移動

yayadonさん、ご回答ありがとうございます。
 
IUIAutomation::CreateTrueCondition メソッドで全ての要素を選択して、
「あれっ？」と思ってたので助かりました。m(_ _)m
(要素数が7の場合もあるのですが) 

 92 
ディスプレイ


ナビゲーション ボタン
GodMode に戻る (Alt+左矢印)
進む (Alt+右矢印)
最近表示した場所

上へバンド ツール バー
"デスクトップのカスタマイズ" へ (Alt+上矢印)



アドレス: コントロール パネル\デスクトップのカスタマイズ\ディスプレイ
?デスクトップ
コントロール パネル
デスクトップのカスタマイズ
ディスプレイ
アドレス バンド ツール バー
前の場所
"ディスプレイ" を最新の情報に更新(F5)




検索ボックス
検索

ディスプレイ

コントロール パネル ホーム
解像度の調整
アイコン
色の調整
ディスプレイの設定の変更
ClearType テキストの調整
関連項目
個人設定
デバイスとプリンター

Vertical
1 行上
表示位置
下へドラッグ
1 行下
ヘルプ
すべての項目のサイズを変更する
これらのいずれかのオプションを選択することで、デスクトップ上のテキストやその他の項目を拡大できます。一時的に画面上の一部のみを拡大するには、拡大鏡ツールを使用します。
拡大鏡
小 - 100% (既定)(S)
中 - 125%(M)
大 - 150%(L)
カスタム(C) - 200%
カスタム サイズ変更オプション
テキスト サイズのみを変更する
デスクトップ上のすべての項目のサイズを変更する代わりに、特定の項目のテキスト サイズのみを変更することができます。
デスクトップ項目

開く
フォント サイズ

開く
太字
適用(A)
警告
一部の項目が画面に収まらない可能性があります。

アプリケーション
ファイル
ファイル
編集
編集
表示
表示
ツール
ツール
ヘルプ
ヘルプ

切り取り
コピー
貼り付け
削除
プロパティ
選択した項目を電子メールで送信する
Classic Explorer Settings

システム
システム
最小化
元のサイズに戻す
閉じる

Private Declare PtrSafe Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As LongPtr


Sub hoge()

    Dim hwnd As LongPtr
    Dim o As IUIAutomation2
    Dim e As IUIAutomationElement
    Set o = New CUIAutomation8

    hwnd = FindWindow("CabinetWClass", "ディスプレイ")
    If hwnd = 0 Then Exit Sub

    Set e = o.ElementFromHandle(ByVal hwnd)
    Dim oCondition As IUIAutomationCondition
    Set oCondition = o.CreateTrueCondition

    Dim oArr As IUIAutomationElementArray
    Set oArr = e.FindAll(TreeScope_Subtree, oCondition)
    Dim oChild As IUIAutomationElement
    Dim n As Long, i As Long
    n = oArr.Length
    Debug.Print n

    For i = 0 To n - 1
        Set oChild = oArr.GetElement(i)
        Debug.Print oChild.CurrentName
    Next

End Sub
回答
投稿日時: 13/03/21 11:12:45
投稿者: kumatti
投稿者のウェブサイトに移動

「適用(&A)」ボタンがグレーアウトしたままなので、IUIAutomationValuePattern::SetValue メソッド呼び出し後、上の親ウィンドウに対して、通知コードは必須らしいですね。
コントロールIDが0なのでどうしたらいいかは分かりませんでした。orz 

Sub hoge3()

    Dim hwnd As LongPtr
    hwnd = FindWindow("CabinetWClass", "ディスプレイ")
    If hwnd = 0 Then Exit Sub

    Dim iUIA2 As IUIAutomation2
    Set iUIA2 = New CUIAutomation8

    Dim iElemTop As IUIAutomationElement
    Set iElemTop = iUIA2.ElementFromHandle(ByVal hwnd)
    
    Dim iCnd As IUIAutomationCondition
    Set iCnd = iUIA2.CreatePropertyCondition(UIA_ControlTypePropertyId, _
                                             UIA_ComboBoxControlTypeId)

    Dim iElemArray As IUIAutomationElementArray
    Set iElemArray = iElemTop.FindAll(TreeScope_Subtree, iCnd)
    If iElemArray Is Nothing Then Exit Sub

    Dim oVlue1 As IUIAutomationValuePattern
    Dim oVlue2 As IUIAutomationValuePattern

    Set oVlue1 = iElemArray.GetElement(0).GetCurrentPattern(UIA_ValuePatternId)
    Set oVlue2 = iElemArray.GetElement(1).GetCurrentPattern(UIA_ValuePatternId)

    Dim v
    For Each v In VBA.Array("タイトル バー", _
                            "メニュー", _
                            "メッセージ ボックス", _
                            "パレット タイトル", _
                            "アイコン", _
                            "ヒント")
        oVlue1.SetValue v
        oVlue2.SetValue "12"
    Next

End Sub
回答
投稿日時: 13/03/21 11:35:38
投稿者: kumatti
投稿者のウェブサイトに移動

定義上、CurrentNativeWindowHandle は使えないので、IUnknown_QueryService 経由でIUIAutomationElementからIAccessibleを取り出して、IUnknown_GetWindow でhwndを得て、
それをGetParentで指定して得られたhwndに対してCBN_SELCHANGE を送信して対処しようと思います。
投稿日時: 13/03/22 02:05:26
投稿者: yayadon

# 時間があれば調査したいところですが，わかってるとこだけでよければ...
 
 

kumatti さんの引用:
定義上、CurrentNativeWindowHandle は使えないので、

 
ウィンドウハンドルの取得 
Dim Elem As IUIAutomationElement
Set Elem = ...

Dim vntHWnd As Variant
vntHWnd = Elem.GetCurrentPropertyValue(UIA_NativeWindowHandlePropertyId)

 
コントロールの探索 
Dim UIA2 As IUIAutomation2
Set UIA2 = New CUIAutomation8

Dim TreeWalker As IUIAutomationTreeWalker
Set TreeWalker = UIA2.ContentViewWalker     '< ControlViewWalker < RawViewWalker

Dim Elem As IUIAutomationElement
Set Elem = ...

Dim ElemParent As IUIAutomationElement
Set ElemParent = TreeWalker.GetParentElement(Elem)  ' コンテント ツリー上の親

 
cf.
ControlViewWalker と ContentViewWalker の違いは以下のリンクの一番下の図(UI Spy のとこ)
http://msdn.microsoft.com/en-us/library/windows/desktop/ee671698%28v=vs.85%29.aspx
 
各コントロールでサポートされている可能性のある
　UI Automation Property　(GetCurrentPropertyValue)
　Control Pattern　　　　 (GetCurrentPattern)
　UI Automation Event
は，
コントロール タイプ
http://msdn.microsoft.com/en-us/library/windows/desktop/ee671633%28v=vs.85%29.aspx
の各コントロールのところにあります。
　
 
　
 
# しばらく開けておきます。
　

回答
投稿日時: 13/03/22 08:43:49
投稿者: kumatti
投稿者のウェブサイトに移動

yayadonさん、ご回答ありがとうございます。
 
> ウィンドウハンドルの取得
TypeLibを直していたのですが、
http://msmania.wordpress.com/2011/10/
に有るようなループで最後まで出来なかったので、助かります。 

error MIDL2025 : syntax error : expecting a type specification near "OrientationType"

それで続きなのですが、Spy++で同じMessageだと思うのですが、お手上げです。
APIに詳しいわけでもないので、私にはこの辺が限界の様です。 
Private Declare PtrSafe Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As LongPtr
Private Declare PtrSafe Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As LongPtr, ByVal wMsg As Long, ByVal wParam As LongPtr, lParam As Any) As LongPtr
Private Declare PtrSafe Function GetParent Lib "user32" (ByVal hwnd As LongPtr) As LongPtr
Private Const WM_COMMAND = &H111
Private Const CBN_SELCHANGE = 1

Sub hoge4()

    Dim hwnd As LongPtr
    hwnd = FindWindow("CabinetWClass", "ディスプレイ")
    If hwnd = 0 Then Exit Sub

    Dim iUIA2 As IUIAutomation2
    Set iUIA2 = New CUIAutomation8

    Dim iElemTop As IUIAutomationElement
    Set iElemTop = iUIA2.ElementFromHandle(ByVal hwnd)
    
    
    Dim iCnd As IUIAutomationCondition
    Set iCnd = iUIA2.CreatePropertyCondition(UIA_ControlTypePropertyId, _
                                             UIA_ComboBoxControlTypeId)
    Dim iElemArray As IUIAutomationElementArray
    Set iElemArray = iElemTop.FindAll(TreeScope_Subtree, iCnd)
    If iElemArray Is Nothing Then Exit Sub

    Dim oVlue1 As IUIAutomationValuePattern
    Dim oVlue2 As IUIAutomationValuePattern

    Set oVlue1 = iElemArray.GetElement(0).GetCurrentPattern(UIA_ValuePatternId)
    Set oVlue2 = iElemArray.GetElement(1).GetCurrentPattern(UIA_ValuePatternId)

    Dim o1 As IUIAutomationElement
    Set o1 = iElemArray.GetElement(0)

    Dim o2 As IUIAutomationElement
    Set o2 = iElemArray.GetElement(1)

    Dim vntHWnd1 As Variant
    vntHWnd1 = o1.GetCurrentPropertyValue(UIA_NativeWindowHandlePropertyId)
    Dim h1 As LongPtr
    h1 = vntHWnd1

    Dim vntHWnd2 As Variant
    vntHWnd2 = o2.GetCurrentPropertyValue(UIA_NativeWindowHandlePropertyId)
    Dim h2 As LongPtr
    h2 = vntHWnd2

    Dim v
    For Each v In VBA.Array("タイトル バー", _
                            "メニュー", _
                            "メッセージ ボックス", _
                            "パレット タイトル", _
                            "アイコン", _
                            "ヒント")
        oVlue1.SetValue v
        SendMessage GetParent(h1), WM_COMMAND, CBN_SELCHANGE * &H10000 Or 0, ByVal h1
        oVlue2.SetValue "12"
        SendMessage GetParent(h2), WM_COMMAND, CBN_SELCHANGE * &H10000 Or 0, ByVal h2
    Next

End Sub
投稿日時: 13/03/23 02:34:14
投稿者: yayadon

# 感触としては，そっち方面に行ってしまうと難しんじゃないですかね。
 
 
 
Inspect.exe で動作の様子を見ると，
ComboBox をドロップダウンさせた時に
ComboLBox (List)とそのアイテム (ListItem) ができるのが確認できます。
 
その ListItem は IsSelectionItemPatternAvailable が true になっているので，
ListItem から SelectionItemPattern を取得して Select
 
という道筋がまず浮かびますが...
 
# 簡単にはいかないと思います。
# しばらくしたら閉じます。
　
 
　
 
　

トピックに返信