Code for mouse wheel in VBA

[Colleen45]

What VBA code do I use to use the mouse wheel on my own form, or is on one of the properties
Thank you

 

[RoryA]

You need something like this in a normal module:

Option Explicit
Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" _
   (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Private Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" _
      (ByVal hwnd As Long, ByVal nIndex As Long) As Long
Private Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" _
      (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Private Const GWL_STYLE As Long = (-16)           'The offset of a window's style
Private Const WS_SYSMENU As Long = &H80000        'Style to add a system menu
Private Const WS_MINIMIZEBOX As Long = &H20000    'Style to add a Minimize box on the title bar
Private Const WS_MAXIMIZEBOX As Long = &H10000    'Style to add a Maximize box to the title bar
'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

then in your userform you have to specifically determine what you are doing in response to the event:

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

Obviously if you want it to work for more than one control, there will need to be more code!

 

[Colleen45]

Where would i find the normal module ??

 

[RoryA]

You just have to insert a new standard module (I.e. Not a class module) and paste that code in

 

[OTOTO]

You just have to insert a new standard module (I.e. Not a class module) and paste that code in

Is this code for listboxes only? It is not working in my Excel 2007...?

 

[gpsingh]

Re: Code for mouse wheel to scroll Frame on a Userform in VBA

Its Super And Great Job
Thank you

i modified it for Scrolling Frame with Mouse Wheel, Which is on a Userform and Loads Images to View
And its working perfectly

the modification is as
Public Sub MouseWheel(ByVal Rotation As Long)


Const cSCROLLCHANGE As Long = 10


If Rotation > 0 Then


' FOR SCROLL UP
Frame1.ScrollTop = Application.Max(0, Frame1.ScrollTop - cSCROLLCHANGE)


Else
'Scroll down


Frame1.ScrollTop = Application.Min(Frame1.ScrollHeight - Frame1.InsideHeight, Frame1.ScrollTop + cSCROLLCHANGE)


End If
End Sub

Thanks again

 

[Colleen45]

Re: Code for mouse wheel to scroll Frame on a Userform in VBA

?????????????????????????????????????????????????????????????????????????????????????????

 

[gpsingh]

Re: Code for mouse wheel to scroll Frame on a Userform in VBA

?????????????????????????????????????????????????????????????????????????????????????????

yes it works well

 

[JizzleSim]

Re: Code for mouse wheel to scroll Frame on a Userform in VBA

Had to Change some bits of code for me to work (Office 2010):

FROM:
Private Sub UserForm_Activate()
WheelHook ME
End Sub

TO:
Private Sub UserForm_Activate()
WheelHook UserForm1
End Sub

 

[RoryA]

Re: Code for mouse wheel to scroll Frame on a Userform in VBA

That shouldn't be necessary since Me refers to the form containing the code.