I found the below code online (can't remember where), that allows the mouse scroll wheel to function in ComboBoxes of my Userform via API calls; the code works perfectly for that purpose. The problem I am having is what they call "Unhooking" the mouse, or returning the mouse wheel to regular default operation. Currently I cannot get the bit of code for unhooking the mouse to work, and it causes the scroll wheel not to function in Windows period, unless I close down the entire Excel Application. Can someone please chime in and help me figure this out?
Regular Module code:
Option Explicit
Declare Function FindWindow Lib "user32" Alias "FindWindowA" _
(ByVal lpClassName As String, ByVal lpWindowName As String) 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
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 intTopIndex As Integer
'==========================================================================
'\\Copy the Data from lParam of the Hook Procedure argument to our Struct
Function GetHookStruct(ByVal lParam As Long) As MSLLHOOKSTRUCT
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
If (nCode = HC_ACTION) Then
If wParam = WM_MOUSEWHEEL Then
'\\ Don't process Default WM_MOUSEWHEEL Window message
LowLevelMouseProc = True
'\\ Change this to your userform name
With SkillChange_Begin.Controls(Worksheets("Skill Change Detail").Range("AV2").Value)
'\\ 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()
hhkLowLevelMouse = SetWindowsHookEx _
(WH_MOUSE_LL, AddressOf LowLevelMouseProc, Application.Hinstance, 0)
End Sub
'========================================================================
Sub UnHook_Mouse()
If hhkLowLevelMouse <> 0 Then UnhookWindowsHookEx hhkLowLevelMouse
End Sub
Userform Code:
Private Sub Skill1_1_DropButtonClick()
Worksheets("Skill Change Detail").Range("AV2").Value = SkillChange_Begin.Frame31.ActiveControl.Name
intTopIndex = Skill1_1.TopIndex
Hook_Mouse
End Sub
Private Sub UserForm_Terminate()
UnHook_Mouse
End Sub
Upon further research of the inner workings of these API calls, I discovered that the SetWindowsHookEx function sets a hook in place to monitor the mouse usage; this hook is deemed by a numeric value. In order to remove this hook, you must use the complimentary UnhookWindowsHookEx function and the numeric value assigned during the initial hook with the SetWindowsHookEx function. There is no way of knowing this numeric value (that I could figure out) in order to release the hook, so I just devised the simple code below which does the trick:
Sub UnHook_Mouse()
Dim L1 As Long
For L1 = 1 To 10000
UnhookWindowsHookEx L1
Next L1
End Sub