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 52 53 54 55 56 57 58 59 60
| 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 |