CUIAutomationクラスに定義されている"ElementFromPoint"というメソッドですが、
そのままではVBAから呼び出すことはできません。

原因は、ElementFromPointが、"tagPoint"という、x,y 2つのLong型変数を持つ構造体を値渡しする仕様になっており、
VBAでは"ユーザー定義型の値渡し"がサポートされていないからです。


これが使えると、マウスカーソル上のエレメントを起点とする処理が気軽に書けるので
何か対策が無いものかと色々調べていました。


検索する仮定で、以下のような情報を目にしました。


こちらで弁士さんが「低レベル COM API で無理矢理呼び出す」
というアプローチに言及されていました。


こちらは上記「低レベル COM API で無理矢理呼び出す」
を実現したようなやり取りがありました。

手元で同じ処理の再現に挑戦してみましたが、

・英語力の無さもあって処理の意味があまり理解できなかった
・64bit環境向けにコードを変換する必要があるけれど上手く行かなかった
・あてずっぽうで試したけれど、Excelがクラッシュするばかりで一向に成功しなかった
・仮に成功したとしても、そこから他の処理に合流させられる気がしなかった

などの要因により「私には無理」と諦めていました。



代わりの手段としてUIAutomationよりも古い時代の仕組みである
MSAA(Microsoft Active Accessibility)のオブジェクトを
"AccessibleObjectFromPoint"で取得し、
それを"ElementFromIAccessible"でIUIAutomationElementに変換することにしました。

こちらは処理が多少煩雑にはなりますが、概ね目的に沿った処理が実装できました。
以降、若干の心残りを引きずりつつもElementFromPointの件は次第に忘れていきました。


それから約半年後、
ご縁あってVBA会（第55回 Excel RPA IT限界集落 UI Automationの雄叫び）
に登壇させていただきました。

※厳密には、デスクトップ自動化に限定した仕組みは
　"RPA"ではなく"RDA"と区別して呼称しないと怒られる世界があるらしいです。


この勉強会が切っ掛けになり、当時挫折した
ElementFromPointの呼び出しへの挑戦を再開しました。

丁度ChatGPTが公開されていたので試しに相談しました。
回答自体はデタラメでしたが、やりとりの中で発想のヒントを得た結果、
ようやく正常に動作させることに成功しました。


自分の手元で正常に動作する最低限のコードはできたので、
そこから「どんな仕組みで動いているのか」を理解するための調査を行い、
最終的には割と正確にAPI関数を使いこなした処理として
"ElementFromPoint"を実装することに成功しました。


以下がそのコードになります。

＜標準モジュール　M_ElementFromPoint.bas＞
Option Explicit

'GetCursorPos関数'
'マウスカーソルの座標をPOINTAPI構造体として取得する'
Public Declare PtrSafe Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long

'POINTAPI構造体'
Public Type POINTAPI
    x As Long
    y As Long
End Type


'DispCallFunc関数'
'クラスインスタンスの関数ポインタを使用することで、'
'任意のオプション（呼び出し規約等）でオブジェクトのメソッドを実行する'
Public Declare PtrSafe Function DispCallFunc Lib "oleaut32.dll" ( _
    ByVal pvInstance As LongPtr, _
    ByVal offsetinVft As LongPtr, _
    ByVal CallConv As Long, _
    ByVal retTYP As Integer, _
    ByVal paCNT As Long, _
    ByRef paTypes As Integer, _
    ByRef paValues As LongPtr, _
    ByRef retVAR As Variant _
) As Long

'CUIAutomation::ElementFromPointをDispCallFunc経由で呼び出すための定数セット'
Public Const S_OK = 0
Public Const CC_STDCALL As Long = 4

#If Win64 Then
    Public Const pElementFromPoint As Long = 56
    'Address of 8th Function in the virtual function table of the CUIAutomation Class            : (8-1)th * 8 Byte'
    Public Const pCount = 2
    'Number of arguments in 64bit environment ( pt, Element* )'
#Else
    Public Const pElementFromPoint As Long = 28
    'Address of 8th Function in the virtual function table of the CUIAutomation Class            : (8-1)th * 4 Byte'
    Public Const pCount = 3
    'Number of arguments in 32bit environment ( pt.x, pt.y, Element* )'
#End If

'指定された座標のエレメントを取得するメソッド'
Public Function ElementFromPoint(ByRef uia As CUIAutomation, ByRef pt As POINTAPI) As IUIAutomationElement

    Dim Element As IUIAutomationElement
    Dim vParams(pCount) As Variant     'ElementFromPointに渡す各種引数を、バリアント型の配列として準備'
    Dim vParamPtr(pCount) As LongPtr   'ElementFromPointに使う各種引数のポインタを、配列として準備'
    Dim vParamType(pCount) As Integer  'ElementFromPointに使う各種引数の型を示す値を、Integer型の配列として準備'


    '引数本体の格納処理（32bitと64bitで処理が分岐）'
    #If Win64 Then
    
        '64bitExcelではWOW64を通さず直接関数が呼び出される。'
        'stdcall呼び出し規約も無視されるため、引数はCPU内ではスタック領域ではなく'
        'レジスタにそのまま放り込まれる。その結果、CUIAutomationのインスタンス領域の'
        '不適切なアドレスに値が渡されてメモリ破壊が起こりExcelがクラッシュするリスクがある。'
        'これを防ぐため、事前にPINTAPIの各メンバを、呼び出し先で格納されるtagPOINTと'
        '互換性がある単一の変数に手動で格納しておく必要がある。'
        Dim llpt As LongLong
        llpt = pt.y * (2 ^ 32) + pt.x
        'Shift y left by 32 bits and then add x to put the two parameters into one variable'
        '0000YYYY pt.y '
        'YYYY0000 pt.y * 2 ^ 32 '
        'YYYYXXXX (pt.y * 2 ^ 32) + pt.x '
        
        vParams(0) = llpt
        vParams(1) = VarPtr(Element)
    
    #Else
    
        '32bit環境ではWOW64の中間処理で構造体の各メンバに適切に値が渡されるため、渡し先の仕様を配慮する必要が無い'
        vParams(0) = pt.x
        vParams(1) = pt.y
        vParams(2) = VarPtr(Element)
    
    #End If

    '引数の情報（型とアドレス）の格納処理'
    Dim pIndex As Long
    For pIndex = 0 To pCount
        vParamPtr(pIndex) = VarPtr(vParams(pIndex))   'ElementFromPointに使う各種引数のポインタ'
        vParamType(pIndex) = VarType(vParams(pIndex)) 'ElementFromPointに使う各種引数の型を示す値'
    Next

    Dim lRtn As Variant  'DispCallFuncの成否判定を格納する変数'
    Dim vRtn As Variant  'ElementFromPointの成否判定を格納する変数'

    lRtn = DispCallFunc(ObjPtr(uia), pElementFromPoint, CC_STDCALL, vbLong, pCount, vParamType(0), vParamPtr(0), vRtn)
    '　　　　　　　　　　　ByVal　　　　　ByVal　　　    　ByVal　 　ByVal 　ByVal　　　ByRef　　　　ByRef　　　 ByRef'
                
                
    '＜DispCallFuncがどのようにしてElementFromPointを呼び出しているのかの解読＞'
    
    '（第一引数）CUIAutomationクラスの、'
    '（第二引数）仮想関数テーブル上の、8番目のポインタが示すアドレスに展開されている処理を実行してください。'
    
    '（第三引数）呼び出し規約は「CC_STDCALL」です。※64bit版のExcelでは、この値は無視される'

    '（第四引数）実行した処理の戻り値（ElementFromPointの成否判定）はLong型で受け取ります。'

    '（第五引数）引数は64bit版では2つ、32bit版では3つあります。（値渡し）'

    '（第六引数）「引数の型の種類を示す値」を格納した配列はここにあります。（参照渡し）'

    '（第七引数）「引数本体が存在するメモリアドレスの値」を格納した配列はここにあります。（参照渡し）'

    '（第八引数）実行した処理の戻り値（ElementFromPointの成否判定）はここ(vRet)に格納してください。（参照渡し）'
    
                
    If lRtn = S_OK Then
        If vRtn = S_OK Then
            If Not Element Is Nothing Then
                Set ElementFromPoint = Element
                Set Element = Nothing
                'ElementをIUnknown::Releaseで解放しようとすると、'
                '呼出元が参照しようとするインターフェースも壊れてExcelがクラッシュするようなので注意'
            End If
        Else
            SetLastError vRtn
            Debug.Print ShowErrorMessage
        End If
    Else
        SetLastError lRtn
        Debug.Print ShowErrorMessage
    End If
    
End Function


'現在のカーソル位置のエレメントを取得するメソッド'
'（GetCursorPosも関数側に委託しているので、カーソル以外の座標を渡す必要が無いならこちらを使う方が楽）'
Public Function ElementFromCursor(ByRef uia As CUIAutomation) As IUIAutomationElement

    Dim pt As POINTAPI
    GetCursorPos pt
    
    Dim elem As IUIAutomationElement
    Set elem = ElementFromPoint(uia, pt)

    If Not elem Is Nothing Then
        Set ElementFromCursor = elem
    End If

End Function
＜標準モジュール　M_Sample.bas＞
Option Explicit

Sub ElemntFromPointサンプル()
    
    '実行すると、Escキーやリセットボタンなどで処理を止めるまでカーソル上のエレメントを取得し続けます'
    
    Dim uia As New CUIAutomation
    Dim elem As IUIAutomationElement
    Dim pt As POINTAPI
    
    Do
        
        'カーソル座標取得'
        GetCursorPos pt
        
        '座標上のエレメントを取得'
        Set elem = ElementFromPoint(uia, pt)
        
        If Not elem Is Nothing Then
            Debug.Print (elem.CurrentName)
            Set elem = Nothing
        End If
        
        DoEvents
        
    Loop
    
End Sub


Sub ElementFromCursorサンプル()
    
    '実行すると、Escキーやリセットボタンなどで処理を止めるまでカーソル上のエレメントを取得し続けます'
    
    Dim uia As New CUIAutomation
    Dim elem As IUIAutomationElement
    
    Do

        'カーソル上のエレメントを取得'
        Set elem = ElementFromCursor(uia)
        
        If Not elem Is Nothing Then
            Debug.Print (elem.CurrentName)
            Set elem = Nothing
        End If
        
        DoEvents
        
    Loop
    
End Sub



エラーメッセージ処理は、ほぼ丸ごとこちらを使わせていただきました。
＜標準モジュール　M_ErrorAPI.bas＞
Option Explicit

Private Declare PtrSafe Function GetLastError Lib "kernel32.dll" () As Long
Declare PtrSafe Sub SetLastError Lib "kernel32" (ByVal dwErrCode As Long)

Private Declare PtrSafe Function FormatMessage Lib "kernel32" Alias "FormatMessageA" ( _
        ByVal dwFlags As FORMAT_MESSAGE_FLAGS, _
        ByRef lpSource As Any, _
        ByVal dwMessageId As Long, _
        ByVal dwLanguageId As Long, _
        ByVal lpBuffer As String, _
        ByVal nSize As Long, _
        ByRef Arguments As LongPtr _
    ) As Long

Private Enum FORMAT_MESSAGE_FLAGS
    MAX_WIDTH_MASK = &HFF&

    ALLOCATE_BUFFER = &H100& 'FormatMessage 側で文字列領域を割り当ててもらう(結果の取得には要メモリ操作)。'
    IGNORE_INSERTS = &H200&
    FROM_STRING = &H400&
    FROM_HMODULE = &H800&
    FROM_SYSTEM = &H1000& 'システムからメッセージを取得する(DLL関数のエラー取得時など)'
    ARGUMENT_ARRAY = &H2000&
End Enum

Public Function ShowErrorMessage() As String
    
    Dim er As Long
    er = GetLastError()

   ShowErrorMessage = GetDllErrorMessage(er)
    
End Function

'DLL 関数のエラーメッセージを取得する。'
'dwMessageId    :エラーメッセージの Id。省略時は Err.LastDllError が使用される。'
Public Function GetDllErrorMessage( _
        Optional ByVal dwMessageId As Long = 0 _
    ) As String

    '引数省略対応。'
    If dwMessageId = 0 Then _
        dwMessageId = VBA.Information.Err().LastDllError

    'ALLOCATE_BUFFER を指定しないため、自前で領域を確保する。'
    Dim paddingSize As Long
    paddingSize = &HFF
    Const paddingChar = VBA.Constants.vbNullChar

    Dim apiResult As Long
    Do
        'メッセージ用の領域確保。'
        Dim lpBuffer As String
        lpBuffer = VBA.Strings.String$(paddingSize, paddingChar)
        Dim nSize As Long
        nSize = VBA.Strings.Len(lpBuffer)

        apiResult = FormatMessage( _
            FROM_SYSTEM Or MAX_WIDTH_MASK, _
            0, _
            dwMessageId, _
            0, _
            lpBuffer, _
            nSize, _
            0)

        '失敗時(≒領域不足時)は 0 になる。'
        If apiResult <> 0 Then _
            Exit Do

        '確保サイズを大きくして再トライ。'
        paddingSize = paddingSize * 2
    Loop

    '必要な範囲だけ取得して出力(apiResult の結果そのままは使いにくい)。'
    Let GetDllErrorMessage = VBA.Strings.Left$(lpBuffer, VBA.Strings.InStr(1, lpBuffer, paddingChar) - 1)
End Function

自分自身を理解させる目的もあり、コード内に各処理の詳細な意味をコメントで記載したので
ソースを追えば自然とDispCallFuncの仕組みも分かってくると思います。


長くなりましたが、これでVBAからでも気兼ねなくElementFromPointが使えるようになりました。


ファイルはこちらにもアップロードしています。
改善点が出てきた場合は修正するかもしれません。


（色々な補足）

＜DispCallFuncについて＞
コード内でも解説していますが、DispCallFuncとElementFromPointの相性がよろしくなく、
Excelが32bitと64bitのどちらで動作しているかで処理を分ける必要があります。
「とりあえずLongPtr型にしておけば良い」が通用しないケースが存在することを初めて知りました。

＜仮想関数テーブルのオフセット値について＞
コード内では何気なく記載していますが、
今回呼び出したElementFromPointが「CUIAutomationクラス内で８番目に定義された関数である」
という情報はどこから入手したのか、当時私には分かりませんでした。

Twitter上で諸先輩方に教えていただいたのですが、
COMのdllファイルの内容を参照できる「oleview.exe」というツールが
Windows SDKに付属していました。


上記ツイートで簡単に使い方を説明していますが、
OLE/COM Object ViewerからITypeLib Viewerを呼び出してCOMインターフェースを開き、
該当クラスのインターフェース部分を探して関数を１つずつ数えることになります。

なお、全てのクラスは"IUnknown"インターフェースを継承しているため
"IUnknown"の3つのメソッドが先頭に隠れており、それをオフセット値に含める必要があります。

このオフセットの値というか、仮想関数テーブル（関数ポインタの配列のようなもの？）の
各ポインタのサイズが32bit環境では4バイト、64bit環境では8バイトなので
ここも "#IF WIN64 Then" の条件付きコンパイルによって値を使い分けなければなりません。


＜呼び出し規約について（参考にならない参考情報）＞
APIやCOMで用意されている関数に関連して、「呼び出し規約」というものがあります。
これは関数の動作時に引数の扱い方などを定めたルールです。

普段意識することはありませんが、
今回、DispCallFunc関数の第三引数でこれを指定する必要がありました。
参考情報程度になりますが、64bitで動作するアプリケーションの場合、
この呼び出し規約を指定する引数は無視されます。
試しに10や1000,55555などの値を渡しても正常に動作しました。

この「呼び出し規約」が、引数がCPU内部のどこに渡されるか　に影響してきます。

32bit版のWindows APIで使用する"stdcall"の場合、引数は「スタック」という所に格納されます。
これが64bit版Excelになると、引数は４つまでは「レジスタ」という部分に格納されることになります。

「だからどうした」と言われても何も答えられないのですが、
これを読んだ誰かが、他の処理で上手く動かない時のヒントになれば　と思い書き残しておきます。


＜WOW64について（参考にならない参考情報）＞
32bit版のExcelだと、DispCallFunc経由でElementFromPointに引数を渡す際、
POINT構造体のメンバ変数をそのまま渡してしまっても、すんなりと動作してしまいます。

ElementFromPoint側で定義は

HRESULT _stdcall ElementFromPoint(
                [in] tagPOINT pt, 
                [out, retval] IUIAutomationElement** element);


となっているので、本来は引数の数は２つにしなければならないはずです。

引数を３つとして渡してしまえる理由を調べてみたのですが、
どうやら「32bit版だから」というのが答えになるようです。

64bit版のWindows上で動作する32bit版ExcelのVBAからAPIやCOMを呼び出す場合、
user32.dllなどの参照先は「System32」フォルダではなく、「SysWOW64」フォルダになります。

「SysWOW64」側のAPIを呼び出す時、内部的には「WOW64.dll」などのAPIが中継役になり、
構造体のメンバ変数のサイズやメモリ上のアドレスを、
x64アーキテクチャ上で扱える形に変換している　という情報に行き当たりました。
（参考記事：日経XTECH）

この中間処理のお陰で、32bit版Excelでは、引数の個数の整合性を意識することなく
ElementFromPointを呼び出すことができるようです。

逆に64bit版のExcel VBAではこのような親切な中間処理が働かないため、
ユーザー側で明示的に変数のサイズやアドレスが噛み合うように調整する必要があるようです。
この調整が上手く行っていないと、関数呼び出し先付近の意図しないアドレスの値を
変更しようとしてしまうなどの致命的なエラーにより、Excelがクラッシュしてしまうのです。




始まりは単純に「ElementFromPointを使いたい！」と思っただけでしたが、
仕組みをきちんと理解した上でそれを実現しようとする過程で実に多くの学びがありました。