Mouse wheel scroll in a combobox on userform (Lots of Code)

[Phil_C]

Hello All
I have seen some code around that allows scrolling in listboxes using the mousewheel. I have also seen some code here on the forums about scrolling through a combobox embedded in a workbook. I have tried adapting both of these to suit a combobox on a userform but I cannot get either to work.

Here is the code that I used for the embedded combobox; I added it to the base code for the userform

I then added the following code to a standard module as stated in the forum post;

In the first section of the code there is a msgbox that never gets shown so I don't think code is recognizing the mouse wheel at all.

The second set of code that I used was set up to work with a listbox and it works perfectly with a listbox control. The problem is I cannot adapt it to suit a combobox and if I use a breakpoint to see what is happening Excel freezes.
The following code is added to the userforms code;

Then in a standard module I added the following code;

I added this section of the code;


I think this should only work on a Combobox but a Combobox does not appear to support the TopIndex value. Is there a way this can be setup to work with a userform combobox?
Sorry about the huge amount of code.

Thanks in advance

Phil

CODE removed to avoid confusion.

 

[Gettingbetter]

Hey Phil, There was far to much code on the page for me to read through, so I thought I would just post the code for a scroll on a userform combobox. You can fit it into your code where necessary.

This is taken from (and changed slightly to fit a userform)

Stick this in a module

Option Explicit

Declare Function FindWindow Lib "user32" Alias "FindWindowA" _
(ByVal lpClassName As String, ByVal lpWindowName As String) As Long

Declare Function GetForegroundWindow Lib "user32" () As Long

Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" _
(ByVal Destination As Long, ByVal Source As Long, ByVal Length As Long)

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

Declare Function CallNextHookEx Lib "user32" (ByVal hHook As Long, _
ByVal nCode As Long, ByVal wParam As Long, lParam As Any) As Long

Declare Function UnhookWindowsHookEx Lib "user32" (ByVal hHook As Long) As Long

Type POINTAPI
  X As Long
  Y As Long
End Type

Type MSLLHOOKSTRUCT 'Will Hold the lParam struct Data
    pt As POINTAPI
    mouseData As Long ' Holds Forward\Bacward flag
    flags As Long
    time As Long
    dwExtraInfo As Long
End Type

Const HC_ACTION = 0
Const WH_MOUSE_LL = 14
Const WM_MOUSEWHEEL = &H20A

Dim hhkLowLevelMouse, lngInitialColor As Long
Dim udtlParamStuct As MSLLHOOKSTRUCT
Public intTopIndex As Integer

'==========================================================================
'\\Copy the Data from lParam of the Hook Procedure argument to our Struct
Function GetHookStruct(ByVal lParam As Long) As MSLLHOOKSTRUCT

   CopyMemory VarPtr(udtlParamStuct), lParam, LenB(udtlParamStuct)
    
   GetHookStruct = udtlParamStuct
    
End Function

'===========================================================================
Function LowLevelMouseProc _
(ByVal nCode As Long, ByVal wParam As Long, ByVal lParam As Long) As Long

    'Avoid XL crashing if RunTime error occurs due to Mouse fast movement
    On Error Resume Next

    If (nCode = HC_ACTION) Then
    
        If wParam = WM_MOUSEWHEEL Then
        
                '\\ Don't process Default WM_MOUSEWHEEL Window message
                LowLevelMouseProc = True
            
                '\\ Change this to your userform name
                With UserForm1.ComboBox1
           
              '\\ if rolling forward increase Top index by 1 to cause an Up Scroll
                If GetHookStruct(lParam).mouseData > 0 Then
                
                    .TopIndex = intTopIndex - 1
                
                    '\\ Store new TopIndex value
                    intTopIndex = .TopIndex
                
                Else '\\ if rolling backward decrease Top index by 1 to cause _
                '\\a Down Scroll
                
                    .TopIndex = intTopIndex + 1
                    
                    '\\ Store new TopIndex value
                    intTopIndex = .TopIndex
                
                End If
                
           End With

        End If
        
        Exit Function
    
    End If

    LowLevelMouseProc = CallNextHookEx(0, nCode, wParam, ByVal lParam)
End Function

'=======================================================================
Sub Hook_Mouse()
hhkLowLevelMouse = SetWindowsHookEx _
(WH_MOUSE_LL, AddressOf LowLevelMouseProc, Application.Hinstance, 0)

End Sub

'========================================================================
Sub UnHook_Mouse()

    If hhkLowLevelMouse <> 0 Then UnhookWindowsHookEx hhkLowLevelMouse

End Sub

and stick this in your userform

Private Sub ComboBox1_DropButtonClick()
    'Store the first TopIndex Value
    intTopIndex = ComboBox1.TopIndex
    Hook_Mouse
End Sub
Private Sub ComboBox1_Exit(ByVal Cancel As MSForms.ReturnBoolean)
    UnHook_Mouse
End Sub

In the first bit in the module be sure to change userform1 to whatever you userform is called.

Cheers
GB

 

[Gettingbetter]

oops didn't put the link in ,
http://www.mrexcel.com/board2/viewtopic.php?t=160464&highlight=scroll+mouse+combobox+userform

 

[Phil_C]

Hello GB
Thanks for the modified code. It works well with two major problems. After it has been run once it kills the scroll for not just excel but also all other applications. I had to close down excel and restart to restore mouse scroll to other applications. Also when I closed the excel file, excel crashed. I think the unhook part is not working correctly.

Regards

Phil

 

[Gettingbetter]

Hey Phil,

I didn't spot that problem originally (prob didn't test very well) but your right it does sometimes not unhook.

I was trying to master this when I came across the below,
http://www.xtremevbtalk.com/showthread.php?t=254921
its better than mine so use this instead, just skip to the end post by Timbo for the scroll code, but NateOs comments are a good read as always.

Sorry for my botched job
Cheers
GB

 

[Phil_C]

Hello GB
Many thanks for your help. The code listed on that page works well. There is only one issue with it and that is excel locks up if there is a breakpoint or an error in the code.

Regards

Phil

 

[Norie]

Phil

Why do you want/need this functionality?

Couldn't you use the inbuilt functionality of the combobox?

 

[Phil_C]

Hello Norie
As far as I know there is no inbuilt functionality for mouse scroll wheel movement in a combobox, textbox or listbox.

Regards

Phil

 

[Norie]

Phil

That's not what I meant.

I was thinking more along the lines of when you enter something into a combobox.

eg the first letter of an item then the combobox goes to the first item beginning with that letter.

But then again I'm not actually sure why you want to use the scrollwheel in the first place.

 

[Phil_C]

Hello Norie
If you have several dozen items all starting with the same letters then you have to keep typing until you have a unique entry. Also if you don't know what is contained in the combobox how are you supposed to know what to type.

Basically it appears to be only Microsoft Office products that do not support the scrolling of comboboxes. Web browsers for example, support the feature.

Regards

Phil