IAccessible を得るには、 方法1) 座標が分かっている場合は、AccessibleObjectFromPoint API 方法2) hWnd が分かっている場合は、AccessibleObjectFromWindow API 方法3) hWnd が無い場合は、ウィンドウを持つ祖先オブジェクトから子孫要素を辿る といった方法があります。 昔は、OLEACC.DLL を参照設定する必要がありましたが、 最近の Excel なら、標準で Dim objAcc As Office.IAccessible と書けるので、そっちでも良いかも。 'Call AccessibleObjectFromPoint32(x, y, objAcc, vnt) 'Call AccessibleObjectFromPoint64(y * &H100000000^ Or x, objAcc, vnt) Call AccessibleObjectFromWindow(ByVal hWnd, OBJID_NATIVEOM, guidIDispatch, objAcc) Debug.Print objAcc.accName
※AccessibleObjectFromPoint の第一引数は POINT 構造体を「値渡し」する仕様なので、 32bit VBA から呼ぶ場合は、第一引数を X 引数と Y 引数に分割したり、 64bit VBA から呼ぶ場合は、X と Y を単一の 64bit 整数型にまとめてから値渡しするなどの工夫が必要。
あるいは、MSAA の後継たる UI Automation 経由でも得られるかと。 参照設定で UIAutomationClient を加えておいたうえで、 UIAutomationClient クラスの ElementFromHandle メソッドか ElementFromPoint メソッドを使うと、 操作対象の IUIAutomationElement を得られるので、そこから Dim objUIAuto As UIAutomationClient.CUIAutomation Set objUIAuto = New UIAutomationClient.CUIAutomation Dim objIUIAutomationElement As UIAutomationClient.IUIAutomationElement Set objIUIAutomationElement = objUIAuto.ElementFromHandle(ByVal hWnd) 'もしくは ElementFromPoint Dim objlegacy As UIAutomationClient.IUIAutomationLegacyIAccessiblePattern Set objlegacy = objIUIAutomationElement.GetCurrentPattern(UIA_LegacyIAccessiblePatternId) Debug.Print legacy.CurrentName といった感じかと。
Private Declare PtrSafe Function GetCursorPos Lib "user32" (ByVal lpPoint As LongPtr) As Long
#If Win64 Then Private Declare PtrSafe Function AccessibleObjectFromPoint Lib "Oleacc" (ByVal ptScreen As LongLong, ByRef ppacc As IAccessible, ByRef pvarChild As Variant) As Long #Else Private Declare PtrSafe Function AccessibleObjectFromPoint Lib "Oleacc" (ByVal x As Long, ByVal y As Long, ByRef ppacc As IAccessible, ByRef pvarChild As Variant) As Long #End If
Public Sub ExampleWankuma103689() Dim pos(0 To 1) As Long Dim endTime As Double
Dim accProp(0 To 2) As Variant Dim acc As Office.IAccessible Const CHILDID_SELF As Variant = &H0& Dim vnt As Variant vnt = CHILDID_SELF
'10 秒間繰り返し Dim msg As String endTime = Timer + 10# Do Until endTime <= Timer GetCursorPos VarPtr(pos(0)) msg = Format(endTime - Timer, "0.000") & "秒 (" & CStr(pos(0)) & ", " & CStr(pos(1)) & ")" Erase accProp On Error Resume Next #If Win64 Then Dim posXY As LongLong posXY = pos(1) * &H100000000^ Or CLngLng(pos(0)) AccessibleObjectFromPoint posXY, acc, vnt #Else AccessibleObjectFromPoint pos(0), pos(1), acc, vnt #End If If Not acc Is Nothing Then accProp(0) = Replace(acc.accName, vbNullChar, "") accProp(1) = Replace(acc.accValue, vbNullChar, "") accProp(2) = Replace(acc.accDescription, vbNullChar, "") Set acc = Nothing msg = msg & ",Name=[" & accProp(0) & "],Value=[" & accProp(1) & "],Description=[" & accProp(2) & "]" End If On Error GoTo 0 [Sheet1!A1].Value = msg DoEvents Loop End Sub