Hi!
I'm a total newbie when it comes to API. I have a pretty long ListBox in my UserForm and I would like to be able to use the mouse wheel to scroll through it. Trouble is I'm using a 64bit version of Excel and I can't find what I need to change from the 32bit code I found. Here's the code:
In a module:
Option Explicit
Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" _
(ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Private Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" _
(ByVal hWnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
'To be able to scroll with mouse wheel within Userform
Private Declare Function CallWindowProc Lib "user32.dll" Alias "CallWindowProcA" ( _
ByVal lpPrevWndFunc As Long, ByVal hWnd As Long, ByVal Msg As Long, ByVal wParam As Long, _
ByVal lParam As Long) As Long
Private Const GWL_WNDPROC = -4
Private Const WM_MOUSEWHEEL = &H20A
Dim LocalHwnd As Long
Dim LocalPrevWndProc As Long
Dim myForm As UserForm
Private Function WindowProc(ByVal Lwnd As Long, ByVal Lmsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
'To handle mouse events
Dim MouseKeys As Long
Dim Rotation As Long
If Lmsg = WM_MOUSEWHEEL Then
MouseKeys = wParam And 65535
Rotation = wParam / 65536
'My Form s MouseWheel function
UserForm1.MouseWheel Rotation
End If
WindowProc = CallWindowProc(LocalPrevWndProc, Lwnd, Lmsg, wParam, lParam)
End Function
Public Sub WheelHook(PassedForm As UserForm)
'To get mouse events in userform
On Error Resume Next
Set myForm = PassedForm
LocalHwnd = FindWindow("ThunderDFrame", myForm.Caption)
LocalPrevWndProc = SetWindowLong(LocalHwnd, GWL_WNDPROC, AddressOf WindowProc)
End Sub
Public Sub WheelUnHook()
'To Release Mouse events handling
Dim WorkFlag As Long
On Error Resume Next
WorkFlag = SetWindowLong(LocalHwnd, GWL_WNDPROC, LocalPrevWndProc)
Set myForm = Nothing
End Sub
In the UserForm:
Option Explicit
Private Sub UserForm_Activate()
WheelHook Me 'For scrolling support
End Sub
Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
WheelUnHook 'For scrolling support
'...
End Sub
Private Sub UserForm_Deactivate()
WheelUnHook 'For scrolling support
'...
End Sub
Public Sub MouseWheel(ByVal Rotation As Long)
'************************************************
' To respond from MouseWheel event
' Scroll accordingly to direction
'
' Made by: Mathieu Plante
' Date: July 2004
'************************************************
If Rotation > 0 Then
'Scroll up
If ListBox1.TopIndex > 0 Then
If ListBox1.TopIndex > 3 Then
ListBox1.TopIndex = ListBox1.TopIndex - 3
Else
ListBox1.TopIndex = 0
End If
End If
Else
'Scroll down
ListBox1.TopIndex = ListBox1.TopIndex + 3
End If
End Sub
Now, when I run this as is, I get a compilation error. I need to change these:
Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" _
(ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Private Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" _
(ByVal hWnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
'To be able to scroll with mouse wheel within Userform
Private Declare Function CallWindowProc Lib "user32.dll" Alias "CallWindowProcA" ( _
ByVal lpPrevWndFunc As Long, ByVal hWnd As Long, ByVal Msg As Long, ByVal wParam As Long, _
ByVal lParam As Long) As Long
to Declare PtrSafe. I did and now when I run it, I get a type incompatibility error with at least this sub
Public Sub WheelHook(PassedForm As UserForm)
'To get mouse events in userform
On Error Resume Next
Set myForm = PassedForm
LocalHwnd = FindWindow("ThunderDFrame", myForm.Caption)
LocalPrevWndProc = SetWindowLong(LocalHwnd, GWL_WNDPROC, AddressOf WindowProc)
End Sub
What else do I have to change to make it work with a 64bit version of Excel? Best case scenario would be a code that runs on either version, but I will be very happy if it works on 64bit.
Hope I'm clear enough. If you need more info, I'll be glad to clarify!
Bookmarks