Listbox Mouse Wheel Scroll 3

[bdmangum]

Howdy! I'm not even certain this is possible, but I would like to have the ability to use the mouse to scroll up and down a listbox contained within a user form. I'm running Excel 2003. I have a form which contains a large numnber of items in a listbox, thus the ability to use the mouse scroll wheel would be very helpful!

If anyone knows how to capture the mouse wheel event, please let me know!

Thanks,
BD

 

[bdmangum]

Still have been unable to resolve this question. Any thoughts?

 

[combo]

You can find solution here (uses API), missing variable is the userform name).

combo

 

[bdmangum]

Thanks for the link combo!

I can't seem to get his code to work. I think this line is giving me problems:

LocalHwnd = FindWindow("ThunderDFrame", MyForm.Caption)

Do I insert my UserForm name in place of "ThunderDFrame"? His function "FindWindow" calls the first variable "lpClassName", so I'm not certain what exactly he is wanting for that slot.

In your post you said the missing variable was the userform name? Missing from where?

Thanks in advance

BD

 

[rmikesmith]

BD,

"ThunderDFrame" is the class name for Userform Windows in XL2000 and later ["ThunderXFrame" for XL97]. You should use that as written. Do you know where your code is failing? For instance, are you getting a value in LocalHWnd, which is the handle to your Userform, if FindWindow succeeds?


Regards,
Mike

 

[bdmangum]

I am getting a value in LocalhWnd. Upon running the function WheelHook, Excel crashes. Per the designer's comments, Excel crashes when there is an error which is not handled.

I'm thinking the problem may be that MyForm.Caption = "" even though the form I am passing have a valid caption. I've run into this in other macros where something declared as Userform is set to equal a valid form, but many of the properties do not transfer.

However, I attempted simply inputting the caption of the form manually and Excel still crashed.

Thoughts?

 

[rmikesmith]

BD,

In the following procedure, are you using the author's Userform name (highlighted) or your own?

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
    [highlight]GROUPSDLG[/highlight].MouseWheel Rotation
End If
WindowProc = CallWindowProc(LocalPrevWndProc, Lwnd, Lmsg, Wparam, Lparam)
End Function

Regards,
Mike

 

[bdmangum]

Thanks Mike! That did the trick. I figured all I needed to change was one variable/name I just couldn't find which one it was.

Thanks to all who provided help!

BD

 

[combo]

Here's slightly more universal code based on the link:

Public Event Rotation(bUp As Boolean)

Public Sub RotateMouse(Rotation As Long)
If Rotation > 0 Then
    RaiseEvent Rotation(True)
Else
    RaiseEvent Rotation(False)
End If
End Sub

Option Explicit

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

Public MouseWheel As clsMouseWheel
Public LocalPrevWndProc As Long

Public Const GWL_WNDPROC = -4
Public Const WM_MOUSEWHEEL = &H20A

Public Function WindowProc(ByVal Lwnd As Long, ByVal Lmsg As Long, ByVal Wparam As Long, ByVal Lparam As Long) As Long
Dim MouseKeys As Long
Dim Rotation As Long
If Lmsg = WM_MOUSEWHEEL Then
    MouseKeys = Wparam And 65535
    Rotation = Wparam / 65536
    MouseWheel.RotateMouse Rotation
End If
WindowProc = CallWindowProc(LocalPrevWndProc, Lwnd, Lmsg, Wparam, Lparam)
End Function

Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" ( _
    ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Private Declare Function SetWindowLong Lib "user32.dll" Alias "SetWindowLongA" ( _
    ByVal hWnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Private WithEvents mMousewheel As clsMouseWheel

Private bMouseIn As Boolean
Public hWnd As Long

Private Sub UserForm_Activate()
hWnd = FindWindow("ThunderDFrame", Me.Caption)
Set MouseWheel = New clsMouseWheel
Set mMousewheel = MouseWheel
For i = 1 To 20
    Me.ListBox1.AddItem "Item " & i
Next i
LocalPrevWndProc = SetWindowLong(Me.hWnd, GWL_WNDPROC, AddressOf WindowProc)
End Sub

Private Sub ListBox1_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal x As Single, ByVal Y As Single)
bMouseIn = True
End Sub

Private Sub mMousewheel_Rotation(bUp As Boolean)
If bMouseIn Then
    With Me
    If bUp Then
        If .ListBox1.TopIndex > 0 Then
            If .ListBox1.TopIndex > 3 Then
                .ListBox1.TopIndex = ListBox1.TopIndex - 3
            Else
                .ListBox1.TopIndex = 0
            End If
        End If
    Else
        .ListBox1.TopIndex = ListBox1.TopIndex + 3
    End If
    End With
End If
End Sub

Private Sub UserForm_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal x As Single, ByVal Y As Single)
bMouseIn = False
End Sub

Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
WheelUnHook
End Sub

Private Sub UserForm_Deactivate()
WheelUnHook
End Sub

Private Sub WheelUnHook()
Dim WorkFlag As Long
On Error Resume Next
WorkFlag = SetWindowLong(Me.hWnd, GWL_WNDPROC, LocalPrevWndProc)
Set MouseWheel = Nothing
End Sub

combo