VBA To Scroll Through ListBox Using Mouse Scroll Wheel

**MrBlackd** · 05-28-2014, 05:13 AM

I have a userform Navi_Form that shows all the visible sheets and by double clicking any item of the listbox ListBox1 the respective sheet is activated.

I wanted to make the list scrollable so I googled for some code and the combined result looks as shown below. However I get excel to crash. Any ideas why?
If I remove the parts that relate to scrolling then there is no issue but that's not the point...
I am aware that this is built in functionality in 2013 but the code is destined for an addon to work on older versions (2007 mainly).

the following is placed in the userform

Code:

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
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


Private Sub ListBox1_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
    Dim i As Integer, sht As String
    For i = 0 To ListBox1.ListCount - 1
        If ListBox1.Selected(i) = True Then
            sht = ListBox1.List(i)
        End If
    Next i
    On Error Resume Next
    Sheets(sht).Activate
    End

End Sub


Private Sub UserForm_Initialize()
    Dim ws As Worksheet
    
    With Me
        .StartUpPosition = 0
        .Left = Application.Left + (0.5 * Application.Width) - (0.5 * .Width)
        .Top = Application.Top + (0.5 * Application.Height) - (0.5 * .Height)
    End With
    
    For Each ws In ActiveWorkbook.Worksheets
        If Not ws.Name = "INDEX" And ws.Visible = True Then ListBox1.AddItem (ws.Name)
    Next ws
    
    ListBox1.Value = ActiveSheet.Name

End Sub

And I have also placed in a standard module the following

Code:

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
        Navi_Form.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

Thanks in advance for any helpful info.

**MrBlackd** · 05-28-2014, 01:57 PM

**Excel Fox** · 05-29-2014, 10:27 AM

MrBlackd,

When you say scrollable, what exactly do you mean? Do you mean your ListBox should have a vertical scrollbar even if it doesn't have enough items in it?

**bakerman** · 05-29-2014, 12:55 PM

**MrBlackd** · 05-29-2014, 12:59 PM

Sorry my mistake, by saying scrollable I meant to be able to use mouse wheel to go up or down in the listbox.

**Excel Fox** · 05-29-2014, 01:24 PM

Sure. Did bakerman's solution suit your purpose?

**MrBlackd** · 05-29-2014, 01:33 PM

I saw it a few secs after posting my reply...

It sure does the scrolling, now I have to adjust the code to have the sheets shown in the listbox, no big deal...
Thank you all guys!

**MrBlackd** · 05-30-2014, 05:21 PM

Dear all thank you for making my life easier and assisting me with any issues that I had...

I am posting a link to a rar file containing the bas and frm modules, that I have exported from the add-on I am compiling, in order to share them with you as a result of my appreciation to all the help provided.

The form will show all the visible sheets in the spreadsheet, highlight the current one that is active and will scroll with mouse wheel while the mouse is over the form. By double clicking any item the respective sheet is activated.

I am also attaching a screenshot in order to be more specific.

Screenshot.PNG

For Office 2013 users this is not needed actually since this functionality is already embedded and the form actually mimics it...

In order to download GO HERE

**bakerman** · 05-30-2014, 06:48 PM

Dear MrBlackd, thank you for sharing and your kind words.
It's always nice to hear that everything worked out like you had in mind.

**Rick Rothstein** · 05-30-2014, 10:55 PM

This thread reminded me of a "Go To Sheet" selector that I develop a few years ago now, and while it does not provide for mouse wheel scrolling, I still think the readers of this thread might be interested in seeing it. What that control does is filter the list of sheet names to only those that begin with the letters typed into an edit field... and I just posted it in my sub-forum (Rick Rothstein's Corner) here on ExcelFox. The article and associated files are located here...

A Neat "Go To Sheet" Selector