Peter Thorntons ComboBox mouse wheel scroll

For anyone not familiar with this, it allows you to use the mouse scroll wheel in a userform and the full code can be viewed here

I know it works in a userform, however I'm trying to use it for an ActiveX ComboBox.

I've set it to trigger as:

Private Sub ComboBox1_DropButtonClick()
HookListBoxScroll ComboBox1, ComboBox1.ComboBox
End Sub

However I'm getting a
Run-time error '438':
Object doesn't support this property or method

Does it simply not work outside a userform or is it something I've done wrong with the syntax here:

HookListBoxScroll ComboBox1, ComboBox1.ComboBox

as needs to be the format of
HookListBoxScroll(frm As Object, Ctl As MSforms.control)

I'll never take the scroll wheel for granted again!

Link to full code is in initial post (the word here).

I'll put the link as the full URL below:

https://social.msdn.microsoft.com/Fo...0?forum=isvvba

All I wish to do is be able to use the mouse wheel to scroll through the combobox list - instead of the worksheet.


Here's the example:

Hi BuZZarD73,

Have you, or perhaps someone else here, manged to apply this code to a dropdown validation list, without using the userforms?

From the example's I've reviewed, and taking a hint from the blog title from which this code orginated, "Mouse scroll in UserForm ListBox in Excel 2010".
I suspect the source code is hardwired for just "User forms"

But if someone else has found a way around this then please share I'll also check other potential sources and provide feed back.

Being an old thread, and my first post, we'll see how we go.

The workbook is huge and contains lots of sensitive information but I'll create an example workbook to illustrate what I'm doing.

In the meantime, the code I'm using is:

Option Explicit

Private Type POINTAPI
        X As Long
        Y As Long
End Type

Private Type MOUSEHOOKSTRUCT
        pt As POINTAPI
        hwnd As Long
        wHitTestCode As Long
        dwExtraInfo As Long
End Type

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

Private Declare Function GetWindowLong Lib "user32.dll" _
                                        Alias "GetWindowLongA" ( _
                                                        ByVal hwnd As Long, _
                                                        ByVal nIndex As Long) As Long

Private 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

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

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

'Private Declare Function PostMessage Lib "user32.dll" _
'                                         Alias "PostMessageA" ( _
'                                                         ByVal hwnd As Long, _
'                                                         ByVal wMsg As Long, _
'                                                         ByVal wParam As Long, _
'                                                         ByVal lParam As Long) As Long

Private Declare Function WindowFromPoint Lib "user32" ( _
                                                        ByVal xPoint As Long, _
                                                        ByVal yPoint As Long) As Long

Private Declare Function GetCursorPos Lib "user32.dll" ( _
                                                        ByRef lpPoint As POINTAPI) As Long

Private Const WH_MOUSE_LL As Long = 14
Private Const WM_MOUSEWHEEL As Long = &H20A
Private Const HC_ACTION As Long = 0
Private Const GWL_HINSTANCE As Long = (-6)

'Private Const WM_KEYDOWN As Long = &H100
'Private Const WM_KEYUP As Long = &H101
'Private Const VK_UP As Long = &H26
'Private Const VK_DOWN As Long = &H28
'Private Const WM_LBUTTONDOWN As Long = &H201

Private mLngMouseHook As Long
Private mListBoxHwnd As Long
Private mbHook As Boolean
Private mCtl As MSForms.Control
Dim n As Long

Sub HookListBoxScroll(frm As Object, ctl As MSForms.Control)
Dim lngAppInst As Long
Dim hwndUnderCursor As Long
Dim tPT As POINTAPI
     GetCursorPos tPT
     hwndUnderCursor = WindowFromPoint(tPT.X, tPT.Y)
     If Not frm.ActiveControl Is ctl Then
             ctl.SetFocus
     End If
     If mListBoxHwnd <> hwndUnderCursor Then
             UnhookListBoxScroll
             Set mCtl = ctl
             mListBoxHwnd = hwndUnderCursor
             lngAppInst = GetWindowLong(mListBoxHwnd, GWL_HINSTANCE)
             ' PostMessage mListBoxHwnd, WM_LBUTTONDOWN, 0&, 0&
             If Not mbHook Then
                     mLngMouseHook = SetWindowsHookEx( _
                                                     WH_MOUSE_LL, AddressOf MouseProc, lngAppInst, 0)
                     mbHook = mLngMouseHook <> 0
             End If
     End If
End Sub

Sub UnhookListBoxScroll()
     If mbHook Then
                Set mCtl = Nothing
             UnhookWindowsHookEx mLngMouseHook
             mLngMouseHook = 0
             mListBoxHwnd = 0
             mbHook = False
        End If
End Sub

Private Function MouseProc( _
             ByVal nCode As Long, ByVal wParam As Long, _
             ByRef lParam As MOUSEHOOKSTRUCT) As Long
Dim idx As Long
        On Error GoTo errH
     If (nCode = HC_ACTION) Then
             If WindowFromPoint(lParam.pt.X, lParam.pt.Y) = mListBoxHwnd Then
                     If wParam = WM_MOUSEWHEEL Then
                                MouseProc = True
'                                If lParam.hwnd > 0 Then
'                                        PostMessage mListBoxHwnd, WM_KEYDOWN, VK_UP, 0
'                                Else
'                                        PostMessage mListBoxHwnd, WM_KEYDOWN, VK_DOWN, 0
'                                End If
'                                PostMessage mListBoxHwnd, WM_KEYUP, VK_UP, 0
                                If lParam.hwnd > 0 Then idx = -1 Else idx = 1
                             idx = idx + mCtl.ListIndex
                             If idx >= 0 Then mCtl.ListIndex = idx
                                Exit Function
                     End If
             Else
                     UnhookListBoxScroll
             End If
     End If
     MouseProc = CallNextHookEx( _
                             mLngMouseHook, nCode, wParam, ByVal lParam)
     Exit Function
errH:
     UnhookListBoxScroll
End Function
'''''''' end normal module code

'http://social.Msdn.microsoft.com/Forums/en-US/isvvba/thread/7d584120-a929-4e7c-9ec2-9998ac639bea#7738fb96-12be-4e3c-af5c-abaae64a5e94
'
'19-Jul-2012

''''' Userform code
Private Sub comboBox1_MouseMove( _
                        ByVal Button As Integer, ByVal Shift As Integer, _
                        ByVal X As Single, ByVal Y As Single)
                HookListBoxScroll Me, Me.ComboBox1
End Sub

Private Sub ListBox1_MouseMove( _
                        ByVal Button As Integer, ByVal Shift As Integer, _
                        ByVal X As Single, ByVal Y As Single)
         HookListBoxScroll Me, Me.ListBox1
End Sub

Private Sub ListBox2_MouseMove( _
                        ByVal Button As Integer, ByVal Shift As Integer, _
                        ByVal X As Single, ByVal Y As Single)
         HookListBoxScroll Me, Me.ListBox2
End Sub
Private Sub UserForm_Initialize()
Dim i As Long
Dim s As String
        s = "this is line "
        For i = 1 To 50
                        Me.ComboBox1.AddItem s & i
                        Me.ListBox1.AddItem s & i
                        Me.ListBox2.AddItem s & i
        Next
End Sub
Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
        UnhookListBoxScroll
End Sub

It won't work with a data validation dropdown because that's not a windowed control, as far as I know.

It is my understanding that both Active X ListBox and ComboBox commands are able to be interfaced with Peter'a code, but I am having this confirmed!

There's also code availble,provided by Jaafar Tribak and posted in a forum titled "Re: How to get handle to a control on a spreadsheet? ", which does allow a mouse scroll interface with ActiveX listBoxs controls.
This code does appear to be based on Peters, but as I havn't been unable to make contatc with Jaafar to discuss His code, I a still waiting for clarification on combobox mouse scrolling.

However, I am doing my best to push forward some clarification son Peter's code and to hopefully post back some working examples

Yes it will work with Activex controls on a sheet, but you asked about validation drop down which aren't Activex.

Yes, My Bad