Discussion :

[Oliv-]

Bonsoir,

J'utilisais IACCESSIBLE pour afficher des informations sur des éléments du RUBAN, avec OFFICE 2010 cela fonctionne très bien, mais avec OFFICE 2016 (et sans doute OFFICE 2013) cela ne renvoi pas l'ensemble des informations notamment accDescription

Donc il faut utiliser UI AUTOMATION avec les nouvelles versions.

Cependant je n'arrive pas à obtenir l'information correspondant à accDescription, sur un Icone cela correspond au Supertip, la description du bouton.
Voici les 2 résultats



Si on utilise des outils comme UISPY.exe on voit bien toutes les infos

AutomationElement
General Accessibility
AccessKey: ""
AcceleratorKey: ""
IsKeyboardFocusable: "True"
LabeledBy: "(null)"
HelpText: "Fait pivoter le texte selon un angle diagonal ou une orientation verticale.\n\nCette option est souvent utilisée pour insér... l'orientation du texte sélectionné pour rétablir l'orientation normale du texte.\n\nAppuyez sur F1 pour obtenir de l'aide."

State
IsEnabled: "True"
HasKeyboardFocus: "False"

Identification
ClassName: "NetUIAnchor"
ControlType: "ControlType.MenuItem"
Culture: "(null)"
AutomationId: ""
LocalizedControlType: "Élément de menu"
Name: "Orientation"
ProcessId: "9712 (EXCEL)"
RuntimeId: "42 3474756 2 56431232 0"
IsPassword: "False"
IsControlElement: "True"
IsContentElement: "True"

Visibility
BoundingRectangle: "(387, 58, 32, 22)"
ClickablePoint: "(null)"
IsOffscreen: "False"

ControlPatterns
ExpandCollapse
ExpandCollapseState: "Collapsed"

idem avec INSPECT en mode ui automation


J'aurais donc besoin de votre aide pour trouver ce qui cloche ou ce qui manque dans mon code
il faut cliquer sur LANCE et on a 3 secondes pour placer la souris sur l'icone souhaité.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
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 lance()
 
    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
        MsgBox "name: " & oIA.accName(CHILDID_SELF) & vbCr & "------------------------------------" _
             & vbCr & "Description: " & oIA.accDescription(CHILDID_SELF) & vbCr & "------------------------------------" _
             & vbCr & "Value: " & oIA.accValue(CHILDID_SELF) & vbCr & "------------------------------------" _
             & vbCr & "KeyboardShortcut: " & oIA.accKeyboardShortcut(CHILDID_SELF) & vbCr & "------------------------------------" _
             & vbCr & "DefaultAction: " & oIA.accDefaultAction(CHILDID_SELF) & vbCr & "------------------------------------" _
             & vbCr & "HelpText: " & oIA.accHelp(CHILDID_SELF) & vbCr & "------------------------------------" _
             & vbCr & "RoleText: " & oIA.AccRole(CHILDID_SELF) & vbCr & "------------------------------------" _
             & vbCr & "Childcount: " & Val(oIA.accChildCount) & vbCr & "------------------------------------" _
             & vbCr & "AccState: " & oIA.AccState(CHILDID_SELF), , "IAccessible"
    End If
 
    Dim uiAuto As UIAutomationClient.CUIAutomation
    Dim elmRibbon As UIAutomationClient.IUIAutomationElement
    Dim cndProperty As UIAutomationClient.IUIAutomationCondition
    Dim ptnAcc As UIAutomationClient.IUIAutomationLegacyIAccessiblePattern
    Dim accRibbon As Office.IAccessible
    Dim i As Long
 
    On Error Resume Next
    Set uiAuto = New UIAutomationClient.CUIAutomation
    Set elmRibbon = uiAuto.ElementFromIAccessible(oIA, 0)
 
    If Not elmRibbon Is Nothing Then
        MsgBox "Name: " & elmRibbon.CurrentName _
             & vbCr & "------------------------------------" _
             & vbCr & "CurrentAcceleratorKey: " & elmRibbon.CurrentAcceleratorKey _
             & vbCr & "CurrentAccessKey: " & elmRibbon.CurrentAccessKey _
             & vbCr & "CurrentAriaProperties: " & elmRibbon.CurrentAriaProperties _
             & vbCr & "CurrentAriaRole: " & elmRibbon.CurrentAriaRole _
             & vbCr & "CurrentAutomationId: " & elmRibbon.CurrentAutomationId _
             & vbCr & "CurrentClassName: " & elmRibbon.CurrentClassName _
             & vbCr & "CurrentFrameworkId: " & elmRibbon.CurrentFrameworkId _
             & vbCr & "CurrentHelpText: " & elmRibbon.CurrentHelpText _
             & vbCr & "CurrentItemStatus: " & elmRibbon.CurrentItemStatus _
             & vbCr & "CurrentItemType: " & elmRibbon.CurrentItemType _
             & vbCr & "CurrentLocalizedControlType: " & elmRibbon.CurrentLocalizedControlType _
             & vbCr & "CurrentProviderDescription: " & elmRibbon.CurrentProviderDescription _
             & vbCr & "processID :" & elmRibbon.CurrentProcessId _
             & vbCr & "CurrentItemType: " & elmRibbon.CurrentItemType, , "ui automation"
 
 
 
    End If
End Sub