Option Explicit
Private Type POINTAPI
x As Long
y As Long
End Type
Private Type MSLLHOOKSTRUCT
pt As POINTAPI
mouseData As Long
flags As Long
time As Long
dwExtraInfo As Long
End Type
Private Declare Function FindWindow Lib "user32" _
Alias "FindWindowA" _
(ByVal lpClassName As String, _
ByVal lpWindowName As String) As Long
Private Declare Function GetWindowLong Lib "user32.dll" _
Alias "GetWindowLongA" _
(ByVal hwnd As Long, _
ByVal nIndex As Long) As Long
Private 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
Private Declare Function CallNextHookEx Lib "user32" _
(ByVal hHook As Long, _
ByVal nCode As Long, _
ByVal wParam As Long, _
lParam As Any) As Long
Private Declare Function UnhookWindowsHookEx Lib "user32" _
(ByVal hHook As Long) As Long
Private Declare Function PostMessage Lib "user32.dll" _
Alias "PostMessageA" _
(ByVal hwnd As Long, _
ByVal wMsg As Long, _
ByVal wParam As Long, _
ByVal lParam As Long) As Long
Private Declare Function WindowFromPoint Lib "user32" _
(ByVal xPoint As Long, _
ByVal yPoint As Long) As Long
Private Declare Function GetCursorPos Lib "user32.dll" _
(ByRef lpPoint As POINTAPI) As Long
Private Const WH_MOUSE_LL As Long = 14
Private Const WM_MOUSEWHEEL As Long = &H20A
Private Const HC_ACTION As Long = 0
Private Const GWL_HINSTANCE As Long = (-6)
Private Const WM_KEYDOWN As Long = &H100
Private Const WM_KEYUP As Long = &H101
Private Const VK_UP As Long = &H26
Private Const VK_DOWN As Long = &H28
Private Const WM_LBUTTONDOWN As Long = &H201
Private lMouseHook As Long
Private lListBoxhwnd As Long
Private bHookSet As Boolean
Private oListBox As MSForms.ListBox
Sub HookListBox(ListBox As MSForms.ListBox)
Dim tPt As POINTAPI
Set oListBox = ListBox
GetCursorPos tPt
lListBoxhwnd = (WindowFromPoint(tPt.x, tPt.y))
PostMessage lListBoxhwnd, WM_LBUTTONDOWN, 0, 0
If Not bHookSet Then
lMouseHook = SetWindowsHookEx _
(WH_MOUSE_LL, _
AddressOf LowLevelMouseProc, GetAppInstance, 0)
If lMouseHook <> 0 Then
bHookSet = True
End If
End If
End Sub
Private Function LowLevelMouseProc _
(ByVal nCode As Long, ByVal wParam As Long, _
ByRef lParam As MSLLHOOKSTRUCT) As Long
On Error Resume Next
If (nCode = HC_ACTION) Then
If WindowFromPoint _
(lParam.pt.x, lParam.pt.y) = lListBoxhwnd Then
If wParam = WM_MOUSEWHEEL Then
LowLevelMouseProc = True
If lParam.mouseData > 0 Then
PostMessage _
lListBoxhwnd, WM_KEYDOWN, VK_UP, 0
PostMessage _
lListBoxhwnd, WM_KEYUP, VK_UP, 0
Else
PostMessage _
lListBoxhwnd, WM_KEYDOWN, VK_DOWN, 0
PostMessage _
lListBoxhwnd, WM_KEYUP, VK_UP, 0
End If
Exit Function
End If
Else
UnhookWindowsHookEx lMouseHook
bHookSet = False
End If
End If
LowLevelMouseProc = _
CallNextHookEx _
(lMouseHook, nCode, wParam, ByVal lParam)
End Function
Private Function GetAppInstance() As Long
GetAppInstance = GetWindowLong _
(FindWindow("XLMAIN", Application.Caption), GWL_HINSTANCE)
End Function