UIAutomationClient elementFromPoint 出现 VBA 错误“用户定义的类型可能无法通过 ByVal 传递”

Question

有没有办法通过VBA（EXCEL）使用UIAutomationClient中的ElementfromPoint

我总是遇到编译错误： “用户定义类型不能传递ByVal”

Sub Test_ElementFromPoint()
Dim uiAuto As New UIAutomationClient.CUIAutomation8
Dim elmRibbon As UIAutomationClient.IUIAutomationElement
Dim pt As tagPOINT

pt.x = 541
pt.y = 99
Set elmRibbon = uiAuto.ElementFromPoint(pt)
MsgBox elmRibbon.CurrentName
End Sub

如果我不能使用 vba 中的 elementfromPoint，我可以使用 Iaccessible 中的 AccessibleObjectFromPoint 来启动查询，但使用它我无法从 ElementFromIAccessible 获取所有信息（.currentHelpText）

代码1

Public Sub Sample()
    MsgBox "button", vbSystemModal
    TrouveButton "Paste"
End Sub

Public Sub TrouveButton(ByVal TabName As String)
    Dim uiAuto As UIAutomationClient.CUIAutomation
    Dim elmRibbon As UIAutomationClient.IUIAutomationElement
    Dim elmRibbonTab As UIAutomationClient.IUIAutomationElement
    Dim cndProperty As UIAutomationClient.IUIAutomationCondition
    Dim aryRibbonTab As UIAutomationClient.IUIAutomationElementArray
    Dim ptnAcc As UIAutomationClient.IUIAutomationLegacyIAccessiblePattern
    Dim accRibbon As Office.IAccessible
    Dim i As Long

    Set elmRibbonTab = Nothing    '???
    Set uiAuto = New UIAutomationClient.CUIAutomation
    Set accRibbon = Application.CommandBars("Ribbon")
    Set elmRibbon = uiAuto.ElementFromIAccessible(accRibbon, 0)
     Set cndProperty = uiAuto.CreatePropertyCondition(UIA_ClassNamePropertyId, "NetUIRibbonButton")

    Set aryRibbonTab = elmRibbon.FindAll(TreeScope_Subtree, cndProperty)
    For i = 0 To aryRibbonTab.Length - 1
        Debug.Print aryRibbonTab.GetElement(i).CurrentName
        If aryRibbonTab.GetElement(i).CurrentName = TabName Then
            Set elmRibbonTab = aryRibbonTab.GetElement(i)
            Exit For
        End If
    Next
    If elmRibbonTab Is Nothing Then Exit Sub
    With elmRibbonTab
        MsgBox "Name: " & .CurrentName _
             & vbCr & "------------------------------------" _
             & vbCr & "CurrentHelpText: " & CStr(.CurrentHelpText) , , "ui automation"
    End With
End Sub

代码2

Option Explicit

Private Type POINTAPI
    x As Long
    Y As Long
End Type

#If VBA7 Then
    Private Declare PtrSafe Function GetCursorPos Lib "user32.dll" (lpPoint As POINTAPI) As Long
    Private Declare PtrSafe Function GetAsyncKeyState Lib "user32" (ByVal vKey As Long) As Integer
    #If Win64 Then
        Private Declare PtrSafe Function AccessibleObjectFromPoint Lib "Oleacc" (ByVal arg1 As LongPtr, ppacc As IAccessible, pvarChild As Variant) As Long
        Private Declare PtrSafe Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As LongPtr)
    #Else
        Private Declare PtrSafe Function AccessibleObjectFromPoint Lib "Oleacc" (ByVal lX As Long, ByVal lY As Long, ppacc As IAccessible, pvarChild As Variant) As Long
    #End If
#Else
    Private Declare Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long
    Private Declare Function AccessibleObjectFromPoint Lib "Oleacc" (ByVal lX As Long, ByVal lY As Long, ppacc As IAccessible, pvarChild As Variant) As Long
    Private Declare Function GetAsyncKeyState Lib "user32" (ByVal vKey As Long) As Integer
#End If

Private Const CHILDID_SELF = &H0&
Private Const S_OK As Long = &H0


Sub Sample2()
'move the mouse on PASTE BUTTON 
    Beep
    Application.OnTime DateAdd("s", 3, Now), "get_element_under_mouse"
End Sub

Private Sub get_element_under_mouse()
    Dim oIA As IAccessible
    Dim oCmbar As CommandBar
    Dim lResult As Long
    Dim tPt As POINTAPI
    Dim oButton As IAccessible

    GetCursorPos tPt

    #If Win64 Then
        Dim lngPtr As LongPtr
        CopyMemory lngPtr, tPt, LenB(tPt)
        lResult = AccessibleObjectFromPoint(lngPtr, oIA, 0)
    #Else
        lResult = AccessibleObjectFromPoint(tPt.x, tPt.Y, oIA, 0)
    #End If

    If lResult = S_OK Then
        '  On Error Resume Next

    End If

    Dim uiAuto As UIAutomationClient.CUIAutomation
    Dim elmRibbon As UIAutomationClient.IUIAutomationElement
    Dim uielmt As UIAutomationClient.IUIAutomationElement
    Dim cndProperty As UIAutomationClient.IUIAutomationCondition

    Dim i As Long

    On Error Resume Next
    Set uiAuto = New UIAutomationClient.CUIAutomation

    ' uiAuto.p
    Set elmRibbon = uiAuto.ElementFromIAccessible(oIA, 0)

    If Not elmRibbon Is Nothing Then
        MsgBox "Name: " & elmRibbon.CurrentName _
             & vbCr & "------------------------------------" _
             & vbCr & "CurrentHelpText: " & CStr(elmRibbon.CurrentHelpText) , , "ui automation"

End If

End Sub

Answer 1

我知道这是一个老问题，但我最近一直在努力解决这个确切的问题，并在一些日本博客上找到了答案（http://blog.livedoor.jp/tarboh_w-inko/archives/39939041.html ）。使用代码链接到 GitHub：https://github.com/tarboh/ElementFromPoint_VBA 我希望这对某人有帮助。不幸的是，就我而言，它在 Excel 中工作，但在 Catia v5 中不起作用:(