1

有没有办法将UIAutomationClient中的 ElementfromPoint与 VBA（EXCEL）一起使用

我总是出现编译错误： “用户定义的类型可能无法通过 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
4

0 回答 0