[XL-2016] [API Windows] Obtenir les tooltips des fenêtres Windows

Bonjour,

Je cherche à accèder aux tooltips à partir de le VBA.

Ci-dessous le code (très) fortement inspiré de ce poste : https://stackoverflow.com/questions/...r-a-given-hwnd

Bien sûr, il ne fonctionne pas, même s'il me trouve quand même des handles de fenêtre associés à la classe tooltips_class32. Pouvez-vous s'il vous plaît m'aider à le corriger ?

Une autre question, y-at'il des formats documentés pour les fonctions call back ?

Code:

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
Option Explicit
 
Private Declare PtrSafe Function EnumWindows Lib "user32" (ByVal lpEnumFunc As LongPtr, ByVal lParam As LongPtr) As Long
 
Private Declare PtrSafe Function GetClassName Lib "user32" Alias "GetClassNameA" (ByVal hwnd As LongPtr, ByVal lpClassName As String, ByVal nMaxCount As Long) As Long
 
Private Declare PtrSafe Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As LongPtr, ByVal wMsg As Long, ByVal wParam As LongPtr, lParam As Any) As Long
 
Private Type RECT
    Left As Long
    Top As Long
    Right As Long
    Bottom As Long
End Type
 
Private Type TOOLINFO
    cbSize As Long
    uFlags As Long
    hwnd As LongPtr
    uId As Long
    RECT As RECT
    hinst As Long
    lpszText As String
End Type
 
Private Const TTM_GETTEXT As Long = &H438
 
'---------------------------------------------
 
'
Sub main()
 
    EnumWindows lpEnumFunc:=AddressOf enumFunc, lParam:=0&
 
End Sub
 
'call back
Private Function enumFunc(ByVal hwnd As LongPtr, ByVal lParam As Long) As Boolean
 
    Dim buffer As String: buffer = Space$(Number:=256)
 
    Dim lRet As Long: lRet = GetClassName(hwnd:=hwnd, lpClassName:=buffer, nMaxCount:=256)
 
    Dim className As String: className = Left$(String:=buffer, Length:=lRet)
 
    If className = "tooltips_class32" Then
 
        Debug.Print hwnd, toolTipText(hwnd:=hwnd, lParam:=lParam)
 
    End If
 
    enumFunc = True
 
End Function
 
'
Private Function toolTipText(ByVal hwnd As LongPtr, ByVal lParam As Long) As String
 
    Dim buffer As String: buffer = Space$(Number:=256)
 
    Dim ti As TOOLINFO
 
    With ti
        .cbSize = Len(ti)
        .hwnd = hwnd
        '.uId = nId
        .lpszText = StrPtr(Ptr:=buffer) 'buffer pointer
    End With
 
    Dim lRet As Long: lRet = SendMessage(hwnd:=hwnd, wMsg:=TTM_GETTEXT, wParam:=256, lParam:=ByVal ti)
 
    toolTipText = Left(String:=buffer, Length:=lRet)
 
End Function

Merci par avance !