Bonjour à tous,

Je me tourne vers vous car le problème ci-contre me chagrine depuis ce matin. En effet, je cherche à faire un code vba compatible 32 et 64 bits.
Le souci est que je tombe sur une "erreur de compilation : incompatibilité de type" sur la procédure
Code : Sélectionner tout - Visualiser dans une fenêtre à part
AddressOf LowLevelMouseProc
dans le Sub Hook_Mouse.

Je ne comprends pas pourquoi? Pouvez-vous m'éclairer de vos lumières?

Le bout de code sert à permettre l'exécution de la molette dans les combobox.

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
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
'-----Allows use of MouseWheel on designated ListBox/ComboBox on a form or, sheet if modified.--------
Option Explicit
 
#If Win64 Then
    Declare PtrSafe Function FindWindow Lib "user32" Alias "FindWindowA" _
                                (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
 
    Declare PtrSafe Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long) As Long
 
    Declare PtrSafe Function GetForegroundWindow Lib "user32" () As Long
 
    Declare PtrSafe Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" _
                           (ByVal Destination As Long, ByVal Source As Long, ByVal Length As Long)
 
    Declare PtrSafe Function SetWindowsHookEx Lib _
                                      "user32" Alias "SetWindowsHookExA" (ByVal idHook As Long, ByVal lpfn As Long, _
                                                                          ByVal hmod As Long, ByVal dwThreadId As Long) As Long
 
    Declare PtrSafe Function CallNextHookEx Lib "user32" (ByVal hHook As Long, _
                                                  ByVal nCode As Long, ByVal wParam As Long, lParam As Any) As Long
 
    Declare PtrSafe Function UnhookWindowsHookEx Lib "user32" (ByVal hHook As Long) As Long
 
    Declare PtrSafe Function GetLastError Lib "kernel32" () As Long  ' Used this one to crack the problem.
#Else
    Declare Function FindWindow Lib "user32" Alias "FindWindowA" _
                                (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
 
    Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long) As Long
 
    Declare Function GetForegroundWindow Lib "user32" () As Long
 
    Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" _
                           (ByVal Destination As Long, ByVal Source As Long, ByVal Length As Long)
 
    Declare Function SetWindowsHookEx Lib _
                                      "user32" Alias "SetWindowsHookExA" (ByVal idHook As Long, ByVal lpfn As Long, _
                                                                          ByVal hmod As Long, ByVal dwThreadId As Long) As Long
 
    Declare Function CallNextHookEx Lib "user32" (ByVal hHook As Long, _
                                                  ByVal nCode As Long, ByVal wParam As Long, lParam As Any) As Long
 
    Declare Function UnhookWindowsHookEx Lib "user32" (ByVal hHook As Long) As Long
 
    Declare Function GetLastError Lib "kernel32" () As Long  ' Used this one to crack the problem.
#End If
 
Type POINTAPI
  X As Long
  Y As Long
End Type
 
Type MSLLHOOKSTRUCT  'Will Hold the lParam struct Data
  pt As POINTAPI
  mouseData As Long  ' Holds Forward\Bacward flag
  flags As Long
  time As Long
  dwExtraInfo As Long
End Type
 
Const HC_ACTION = 0
Const WH_MOUSE_LL = 14
Const WM_MOUSEWHEEL = &H20A
 
Dim hhkLowLevelMouse, lngInitialColor As Long
Dim udtlParamStuct As MSLLHOOKSTRUCT
 
Public Const GWL_HINSTANCE = (-6)
Public intTopIndex As Integer
Public ObjUSF As UserForm, ObjList As Object
 
Function GetHookStruct(ByVal lParam As Long) As MSLLHOOKSTRUCT
' VarPtr returns address; LenB returns size in bytes.
  CopyMemory VarPtr(udtlParamStuct), lParam, LenB(udtlParamStuct)
  GetHookStruct = udtlParamStuct
End Function
 
Function LowLevelMouseProc _
         (ByVal nCode As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
'Avoid XL crashing if RunTime error occurs due to Mouse fast movement
  On Error Resume Next
  '    \\ Unhook & get out in case the application is deactivated
  If GetForegroundWindow <> FindWindow("ThunderDFrame", ObjUSF.Caption) Then
    UnHook_Mouse
    Exit Function
  End If
  If (nCode = HC_ACTION) Then
    If wParam = WM_MOUSEWHEEL Then
      '\\ Don't process Default WM_MOUSEWHEEL Window message
      LowLevelMouseProc = True
      '\\ Change Sheet&\DropDown names as required
      With ObjList
        '\\ if rolling forward increase Top index by 1 to cause an Up Scroll
        If GetHookStruct(lParam).mouseData > 0 Then
          .TopIndex = intTopIndex - 1
          '\\ Store new TopIndex value
          intTopIndex = .TopIndex
        Else  '\\ if rolling backward decrease Top index by 1 to cause _
              '\\a Down Scroll
          .TopIndex = intTopIndex + 1
          '\\ Store new TopIndex value
          intTopIndex = .TopIndex
        End If
      End With
    End If
    Exit Function
  End If
  LowLevelMouseProc = CallNextHookEx(0, nCode, wParam, ByVal lParam)
End Function
 
Sub Hook_Mouse()
' Statement to maintain the handle of the hook if clicking outside of the control.
' There isn't a Hinstance for Application, so used GetWindowLong to get handle.
  If hhkLowLevelMouse < 1 Then hhkLowLevelMouse = SetWindowsHookEx(WH_MOUSE_LL, AddressOf LowLevelMouseProc, _
                                                                   GetWindowLong(FindWindow("ThunderDFrame", ObjUSF.Caption), GWL_HINSTANCE), 0)
End Sub
 
Sub UnHook_Mouse()
  If hhkLowLevelMouse <> 0 Then
    UnhookWindowsHookEx hhkLowLevelMouse
    hhkLowLevelMouse = 0
  End If
End Sub
Je vous remercie par avance pour votre aide et vous souhaite une très bonne année et pleins de bonnes choses, soit dit en passant.

Cordialement,

Anthony