Listbox vba excel прокрутка

1

Answers

• Thanks it is working!

  ---

  Guy Zommer

  • Marked as answer by
    Guy Zommer
    Sunday, July 22, 2012 5:11 AM

All replies

• Thanks for the answer but I already tried this answer and it
  does not work.

  ---

  Guy Zommer

• I am using windows 7

  ---

  Guy Zommer

• Do you happen to be using 64-bit Office 2010 on 64-bit Windows 7?

  ---

  Regards, Hans Vogelaar

• No I am using 32 bit

  ---

  Guy Zommer

• Sorry about that, it doesn’t work for me either. I’m afraid I have no idea how to make it work.

  ---

  Regards, Hans Vogelaar

• This requires Windows API calls. See
  http://www.xtremevbtalk.com/showthread.php?p=812821#post798072

  There are a couple of things wrong, in the normal module change

  Dim MyForm As UserForm
  to
  Dim MyForm As UserForm1 (or the name of the form)

  and change
  GROUPSDLG.MouseWheel Rotation
  to
  MyForm.MouseWheel Rotation  As written with the above changes mouse scroll should work but probably even if the mouse is not directly over the Listbox, or even when the mouse is not over the form. Most userform controls are ‘windowless’, ie without a handle,
  though the Listbox does have one (albeit not one that can be uniquely determined if the form has multiple listboxes or combos). But if assuming only one listbox on the form could return it’s handle and then only call the scroll code if the mouse is over the
  listbox. If interested try including the following

  ' in the declarations area
  Private Type POINTAPI
       x As Long
       y As Long
  End Type
  
  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
  
  Function WindowUnderMouse() As Long
  Dim tPT As POINTAPI
       Call GetCursorPos(tPT)
       WindowUnderMouse = WindowFromPoint(tPT.x, tPT.y)
  End Function
  
  Private Declare Function FindWindowEx Lib "user32" Alias "FindWindowExA" ( _
                               ByVal hWnd1 As Long, ByVal hwnd2 As Long, _
                               ByVal lpsz1 As String, ByVal lpsz2 As String) As Long
  
  ' in function WindowProc
  If Lmsg = WM_MOUSEWHEEL Then
  
  If WindowUnderMouse = LocalHwnd Then
       MouseKeys = wParam And 65535
       Rotation = wParam / 65536
       'My Form    MouseWheel function
       MyForm.MouseWheel Rotation
  End If
  End If
  
  ' in Sub WheelHook
  dim hForm as long, hCtrl as long
  hForm = FindWindow("ThunderDFrame", MyForm.Caption)
  hCtrl = FindWindowEx(hForm , 0&, "F3 Server 60000000", vbNullString)
  LocalHwnd = FindWindowEx(hCtrl, 0&, "F3 Server 60000000", vbNullString)

  Can’t overstress enough how careful need to be with subclassing and hooks like this in VBA. Any unhandled errors or ‘breaking’ the code will crash Excel.  I’m a bit rusty on this type of stuff but I suspect there might be a slightly safer way of doing
  this. Anyway, in a light test it all seems to work

  Peter Thornton

• Thanks but it is not working

  ---

  Guy Zommer

• Try changing
  «F3 Server 60000000»
  to
  «F3 Server 5a940000»

  If still not working explain what you have done. Clarify if you have tested with the first set of corrections to the original code I mentioned, before going on to try the extra stuff I suggested.  Have you debugged return values to the various window
  handles and SetWindowLong, ie LocalPrevWndProc. Also be sure to test first with only one Listbox on the form.

  FWIW I’ve tested in XP & W7, and 2003, 2007 & 2010 and all working. That said I’d probably make further changes for real use.

  Peter Thornton

• The code with the corrections and suggestions should work, however I’ve ahad another look and I thnk something like the following would be safer, partly because the hook should normaly only be running while the mouse is over the Listbox. Also no need to
  cater for the different ListBox window classname in different versions.

  Add a ListBox to a form, code in form and normal modules as indicated.

  ''''' Userform code
  Private Sub ListBox1_Change()
  ' be sure to include Error handling for any code that
  ' might get called while the hook is running
       On Error GoTo errExit
       Me.Caption = Me.ListBox1.Value
       Exit Sub
  errExit:
  End Sub
  
  Private Sub ListBox1_MouseMove( _
               ByVal Button As Integer, ByVal Shift As Integer, _
               ByVal x As Single, ByVal y As Single)
  ' start tthe hook
       HookListBoxScroll
  End Sub
  
  Private Sub UserForm_Initialize()
  Dim i As Long
  Dim s As String
       s = "this is line "
       For i = 1 To 50
               Me.ListBox1.AddItem s & i
       Next
  End Sub
  Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
       UnhookListBoxScroll
  End Sub
  ''''''' end Userform code
  
  ''''''' normal module code
  
  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
  
  Sub HookListBoxScroll()
  Dim lngAppInst As Long
  Dim hwndUnderCursor As Long
  Dim tPT As POINTAPI
          GetCursorPos tPT
          hwndUnderCursor = WindowFromPoint(tPT.x, tPT.y)
          If mListBoxHwnd <> hwndUnderCursor Then
               UnhookListBoxScroll
               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
               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
          On Error GoTo errH 'Resume Next
          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
                               Exit Function
                       End If
               Else
                       UnhookListBoxScroll
               End If
       End If
          MouseProc = CallNextHookEx( _
                               mLngMouseHook, nCode, wParam, ByVal lParam)
       Exit Function
  errH:
          UnhookListBoxScroll
  End Function

  As written the PostMessage API is used to change the Listindex, however with a reference to the form or listbox control could change the .ListIndex and/or .TopIndex directly, in one or more ‘units’ as required.

  I haven’t tested but it should work as-is for multiple ListBox’s.

  The API code would need adapting for use in Office-64

  Peter Thornton

  • Proposed as answer by
    brummgrammierer
    Monday, February 24, 2014 11:13 PM

• > I haven’t tested but it should work as-is for multiple ListBox’s.

  I have now, and for multiple ListBox’s best to ensure the Listbox to be ‘scrolled’ is the ‘active control’, which can be simply done like this —

  ' replace the Listbox mouse move event in the original example with this
  Private Sub ListBox1_MouseMove( _
               ByVal Button As Integer, ByVal Shift As Integer, _
               ByVal X As Single, ByVal Y As Single)
          If Not Me.ActiveControl Is Me.ListBox1 Then
               Me.ListBox1.SetFocus
       End If
       HookListBoxScroll
  End Sub

  It might be worth doing that even if only one Listbox. However, if using the «change .ListIndex and/or .TopIndex directly» approach, rather than the PostMessage API, it’s not necessary for the control to be active.

  Peter Thornton

• Thanks it is working!

  ---

  Guy Zommer

  • Marked as answer by
    Guy Zommer
    Sunday, July 22, 2012 5:11 AM

• I take it you mean the new approach I posted is working, right?. Did you also manage to get the original approach with the corrections as suggested working.

  Peter Thornton

• Yes thank you again!

  ---

  Guy Zommer

• In effect I asked «did A or B work for you, or both» and you replied simply «yes»!

  The reason for asking is I am interested to know which approach worked for you, and if one didn’t why not. It might mean something simple was overlooked while implementing the code (eg all the corrections I suggested were not included), or it might mean
  the approach is unreliable in some systems and best avoided.

  Peter Thornton

• Hi,

  The code from Thursday, July 19, 2012 4:54 PM worked for me.

  ---

  Guy Zommer

• Hello again,

  One more question, How can I implement it for Combo Box?

  Thanks,

  ---

  Guy Zommer

• Which code are you using, I have tried to ask you a few times but your response about the code on a certain date was not helpful. All the code I posted was on 19 July but I didn’t post anything at 4:54pm, at least not in my time zone.

  Please clearly explain which code worked for you and which code, if any doesn’t work. If the first code, which you found yourself didn’t work did you also try the corrections I suggested.

  I also need to know which code to adapt for the combobox

  Peter Thornton

• Thanks for your kind help, I  am sorry if I didn’t explain my self.

  The code that is working for me is:

  1. In the module level:

  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

  Sub HookListBoxScroll()
  Dim lngAppInst As Long
  Dim hwndUnderCursor As Long
  Dim tPT As POINTAPI
          GetCursorPos tPT
          hwndUnderCursor = WindowFromPoint(tPT.X, tPT.Y)
          If mListBoxHwnd <> hwndUnderCursor Then
               UnhookListBoxScroll
               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
               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
          On Error GoTo errH ‘Resume Next
          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
                               Exit Function
                       End If
               Else
                       UnhookListBoxScroll
               End If
       End If
          MouseProc = CallNextHookEx( _
                               mLngMouseHook, nCode, wParam, ByVal lParam)
       Exit Function
  errH:
          UnhookListBoxScroll
  End Function

   2. In UserForm

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

  Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
      UnhookListBoxScroll
  End Sub
  ‘*********************************************»»» end Userform code

   I want to implement the scroll mouse also in combobox.

  Thanks in advance,

  ---

  Guy Zommer

• Thanks for your kind help, I  am sorry if I didn’t explain my self.

  The code that is working for me is:

  1. In the module level:

  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

  Sub HookListBoxScroll()
  Dim lngAppInst As Long
  Dim hwndUnderCursor As Long
  Dim tPT As POINTAPI
          GetCursorPos tPT
          hwndUnderCursor = WindowFromPoint(tPT.X, tPT.Y)
          If mListBoxHwnd <> hwndUnderCursor Then
               UnhookListBoxScroll
               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
               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
          On Error GoTo errH ‘Resume Next
          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
                               Exit Function
                       End If
               Else
                       UnhookListBoxScroll
               End If
       End If
          MouseProc = CallNextHookEx( _
                               mLngMouseHook, nCode, wParam, ByVal lParam)
       Exit Function
  errH:
          UnhookListBoxScroll
  End Function

   2. In UserForm

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

  Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
      UnhookListBoxScroll
  End Sub
  ‘*********************************************»»» end Userform code

   I want to implement the scroll mouse also in combobox.

  Thanks in advance,

  ---

  Guy Zommer

• OK, now I know which code worked for you. Could you also clarify if you tried the code you found, which as written didn’t work, but with the corrections I suggested.

  The following should scroll both ComboBox and ListBox controls with the mouse wheel.

  Put one ComboBox and two ListBox’s on a form. Paste the following into the Userform module and a Normal module as indicated

  '''''' normal module code
  
  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
  ''''''' end Userform code
  

  You can delete the commented PostMessage code

  Peter Thornton

  • Proposed as answer by
    brummgrammierer
    Monday, February 24, 2014 11:13 PM

• Thanks a lot it is working good.

  Regarding the your question «code you found, which as written didn’t work, but with the corrections I suggested» I didn’t try it.

  ---

  Guy Zommer

• Glad it worked and thanks for the feedback.

  Peter Thornton

• OK, now I know which code worked for you. Could you also clarify if you tried the code you found, which as written didn’t work, but with the corrections I suggested.

  The following should scroll both ComboBox and ListBox controls with the mouse wheel.

  Put one ComboBox and two ListBox’s on a form. Paste the following into the Userform module and a Normal module as indicated

  <span style="color:green">'''''' normal module code</span>
  
  <span style="color:blue">Option</span> <span style="color:blue">Explicit</span>
  
  <span style="color:blue">Private</span> Type POINTAPI
          X <span style="color:blue">As</span> <span style="color:blue">Long</span>
          Y <span style="color:blue">As</span> <span style="color:blue">Long</span>
  <span style="color:blue">End</span> Type
  
  <span style="color:blue">Private</span> Type MOUSEHOOKSTRUCT
          pt <span style="color:blue">As</span> POINTAPI
          hwnd <span style="color:blue">As</span> <span style="color:blue">Long</span>
          wHitTestCode <span style="color:blue">As</span> <span style="color:blue">Long</span>
          dwExtraInfo <span style="color:blue">As</span> <span style="color:blue">Long</span>
  <span style="color:blue">End</span> Type
  
  <span style="color:blue">Private</span> <span style="color:blue">Declare</span> <span style="color:blue">Function</span> FindWindow <span style="color:blue">Lib</span> <span style="color:#a31515">"user32"</span> _
                                          <span style="color:blue">Alias</span> <span style="color:#a31515">"FindWindowA"</span> ( _
                                                          <span style="color:blue">ByVal</span> lpClassName <span style="color:blue">As</span> <span style="color:blue">String</span>, _
                                                          <span style="color:blue">ByVal</span> lpWindowName <span style="color:blue">As</span> <span style="color:blue">String</span>) <span style="color:blue">As</span> <span style="color:blue">Long</span>
  
  <span style="color:blue">Private</span> <span style="color:blue">Declare</span> <span style="color:blue">Function</span> GetWindowLong <span style="color:blue">Lib</span> <span style="color:#a31515">"user32.dll"</span> _
                                          <span style="color:blue">Alias</span> <span style="color:#a31515">"GetWindowLongA"</span> ( _
                                                          <span style="color:blue">ByVal</span> hwnd <span style="color:blue">As</span> <span style="color:blue">Long</span>, _
                                                          <span style="color:blue">ByVal</span> nIndex <span style="color:blue">As</span> <span style="color:blue">Long</span>) <span style="color:blue">As</span> <span style="color:blue">Long</span>
  
  <span style="color:blue">Private</span> <span style="color:blue">Declare</span> <span style="color:blue">Function</span> SetWindowsHookEx <span style="color:blue">Lib</span> <span style="color:#a31515">"user32"</span> _
                                          <span style="color:blue">Alias</span> <span style="color:#a31515">"SetWindowsHookExA"</span> ( _
                                                          <span style="color:blue">ByVal</span> idHook <span style="color:blue">As</span> <span style="color:blue">Long</span>, _
                                                          <span style="color:blue">ByVal</span> lpfn <span style="color:blue">As</span> <span style="color:blue">Long</span>, _
                                                          <span style="color:blue">ByVal</span> hmod <span style="color:blue">As</span> <span style="color:blue">Long</span>, _
                                                          <span style="color:blue">ByVal</span> dwThreadId <span style="color:blue">As</span> <span style="color:blue">Long</span>) <span style="color:blue">As</span> <span style="color:blue">Long</span>
  
  <span style="color:blue">Private</span> <span style="color:blue">Declare</span> <span style="color:blue">Function</span> CallNextHookEx <span style="color:blue">Lib</span> <span style="color:#a31515">"user32"</span> ( _
                                                          <span style="color:blue">ByVal</span> hHook <span style="color:blue">As</span> <span style="color:blue">Long</span>, _
                                                          <span style="color:blue">ByVal</span> nCode <span style="color:blue">As</span> <span style="color:blue">Long</span>, _
                                                          <span style="color:blue">ByVal</span> wParam <span style="color:blue">As</span> <span style="color:blue">Long</span>, _
                                                          lParam <span style="color:blue">As</span> <span style="color:blue">Any</span>) <span style="color:blue">As</span> <span style="color:blue">Long</span>
  
  <span style="color:blue">Private</span> <span style="color:blue">Declare</span> <span style="color:blue">Function</span> UnhookWindowsHookEx <span style="color:blue">Lib</span> <span style="color:#a31515">"user32"</span> ( _
                                                          <span style="color:blue">ByVal</span> hHook <span style="color:blue">As</span> <span style="color:blue">Long</span>) <span style="color:blue">As</span> <span style="color:blue">Long</span>
  
  <span style="color:green">'Private Declare Function PostMessage Lib "user32.dll" _</span>
  <span style="color:green">'                                         Alias "PostMessageA" ( _</span>
  <span style="color:green">'                                                         ByVal hwnd As Long, _</span>
  <span style="color:green">'                                                         ByVal wMsg As Long, _</span>
  <span style="color:green">'                                                         ByVal wParam As Long, _</span>
  <span style="color:green">'                                                         ByVal lParam As Long) As Long</span>
  
  <span style="color:blue">Private</span> <span style="color:blue">Declare</span> <span style="color:blue">Function</span> WindowFromPoint <span style="color:blue">Lib</span> <span style="color:#a31515">"user32"</span> ( _
                                                          <span style="color:blue">ByVal</span> xPoint <span style="color:blue">As</span> <span style="color:blue">Long</span>, _
                                                          <span style="color:blue">ByVal</span> yPoint <span style="color:blue">As</span> <span style="color:blue">Long</span>) <span style="color:blue">As</span> <span style="color:blue">Long</span>
  
  <span style="color:blue">Private</span> <span style="color:blue">Declare</span> <span style="color:blue">Function</span> GetCursorPos <span style="color:blue">Lib</span> <span style="color:#a31515">"user32.dll"</span> ( _
                                                          <span style="color:blue">ByRef</span> lpPoint <span style="color:blue">As</span> POINTAPI) <span style="color:blue">As</span> <span style="color:blue">Long</span>
  
  <span style="color:blue">Private</span> <span style="color:blue">Const</span> WH_MOUSE_LL <span style="color:blue">As</span> <span style="color:blue">Long</span> = 14
  <span style="color:blue">Private</span> <span style="color:blue">Const</span> WM_MOUSEWHEEL <span style="color:blue">As</span> <span style="color:blue">Long</span> = &H20A
  <span style="color:blue">Private</span> <span style="color:blue">Const</span> HC_ACTION <span style="color:blue">As</span> <span style="color:blue">Long</span> = 0
  <span style="color:blue">Private</span> <span style="color:blue">Const</span> GWL_HINSTANCE <span style="color:blue">As</span> <span style="color:blue">Long</span> = (-6)
  
  <span style="color:green">'Private Const WM_KEYDOWN As Long = &H100</span>
  <span style="color:green">'Private Const WM_KEYUP As Long = &H101</span>
  <span style="color:green">'Private Const VK_UP As Long = &H26</span>
  <span style="color:green">'Private Const VK_DOWN As Long = &H28</span>
  <span style="color:green">'Private Const WM_LBUTTONDOWN As Long = &H201</span>
  
  <span style="color:blue">Private</span> mLngMouseHook <span style="color:blue">As</span> <span style="color:blue">Long</span>
  <span style="color:blue">Private</span> mListBoxHwnd <span style="color:blue">As</span> <span style="color:blue">Long</span>
  <span style="color:blue">Private</span> mbHook <span style="color:blue">As</span> <span style="color:blue">Boolean</span>
  <span style="color:blue">Private</span> mCtl <span style="color:blue">As</span> MSForms.Control
  <span style="color:blue">Dim</span> n <span style="color:blue">As</span> <span style="color:blue">Long</span>
  
  <span style="color:blue">Sub</span> HookListBoxScroll(frm <span style="color:blue">As</span> <span style="color:blue">Object</span>, ctl <span style="color:blue">As</span> MSForms.Control)
  <span style="color:blue">Dim</span> lngAppInst <span style="color:blue">As</span> <span style="color:blue">Long</span>
  <span style="color:blue">Dim</span> hwndUnderCursor <span style="color:blue">As</span> <span style="color:blue">Long</span>
  <span style="color:blue">Dim</span> tPT <span style="color:blue">As</span> POINTAPI
       GetCursorPos tPT
       hwndUnderCursor = WindowFromPoint(tPT.X, tPT.Y)
       <span style="color:blue">If</span> <span style="color:blue">Not</span> frm.ActiveControl <span style="color:blue">Is</span> ctl <span style="color:blue">Then</span>
               ctl.SetFocus
       <span style="color:blue">End</span> <span style="color:blue">If</span>
       <span style="color:blue">If</span> mListBoxHwnd <> hwndUnderCursor <span style="color:blue">Then</span>
               UnhookListBoxScroll
               <span style="color:blue">Set</span> mCtl = ctl
               mListBoxHwnd = hwndUnderCursor
               lngAppInst = GetWindowLong(mListBoxHwnd, GWL_HINSTANCE)
               <span style="color:green">' PostMessage mListBoxHwnd, WM_LBUTTONDOWN, 0&, 0&</span>
               <span style="color:blue">If</span> <span style="color:blue">Not</span> mbHook <span style="color:blue">Then</span>
                       mLngMouseHook = SetWindowsHookEx( _
                                                       WH_MOUSE_LL, <span style="color:blue">AddressOf</span> MouseProc, lngAppInst, 0)
                       mbHook = mLngMouseHook <> 0
               <span style="color:blue">End</span> <span style="color:blue">If</span>
       <span style="color:blue">End</span> <span style="color:blue">If</span>
  <span style="color:blue">End</span> <span style="color:blue">Sub</span>
  
  <span style="color:blue">Sub</span> UnhookListBoxScroll()
       <span style="color:blue">If</span> mbHook <span style="color:blue">Then</span>
                  <span style="color:blue">Set</span> mCtl = <span style="color:blue">Nothing</span>
               UnhookWindowsHookEx mLngMouseHook
               mLngMouseHook = 0
               mListBoxHwnd = 0
               mbHook = <span style="color:blue">False</span>
          <span style="color:blue">End</span> <span style="color:blue">If</span>
  <span style="color:blue">End</span> <span style="color:blue">Sub</span>
  
  <span style="color:blue">Private</span> <span style="color:blue">Function</span> MouseProc( _
               <span style="color:blue">ByVal</span> nCode <span style="color:blue">As</span> <span style="color:blue">Long</span>, <span style="color:blue">ByVal</span> wParam <span style="color:blue">As</span> <span style="color:blue">Long</span>, _
               <span style="color:blue">ByRef</span> lParam <span style="color:blue">As</span> MOUSEHOOKSTRUCT) <span style="color:blue">As</span> <span style="color:blue">Long</span>
  <span style="color:blue">Dim</span> idx <span style="color:blue">As</span> <span style="color:blue">Long</span>
          <span style="color:blue">On</span> <span style="color:blue">Error</span> <span style="color:blue">GoTo</span> errH
       <span style="color:blue">If</span> (nCode = HC_ACTION) <span style="color:blue">Then</span>
               <span style="color:blue">If</span> WindowFromPoint(lParam.pt.X, lParam.pt.Y) = mListBoxHwnd <span style="color:blue">Then</span>
                       <span style="color:blue">If</span> wParam = WM_MOUSEWHEEL <span style="color:blue">Then</span>
                                  MouseProc = <span style="color:blue">True</span>
  <span style="color:green">'                                If lParam.hwnd > 0 Then</span>
  <span style="color:green">'                                        PostMessage mListBoxHwnd, WM_KEYDOWN, VK_UP, 0</span>
  <span style="color:green">'                                Else</span>
  <span style="color:green">'                                        PostMessage mListBoxHwnd, WM_KEYDOWN, VK_DOWN, 0</span>
  <span style="color:green">'                                End If</span>
  <span style="color:green">'                                PostMessage mListBoxHwnd, WM_KEYUP, VK_UP, 0</span>
                                  <span style="color:blue">If</span> lParam.hwnd > 0 <span style="color:blue">Then</span> idx = -1 <span style="color:blue">Else</span> idx = 1
                               idx = idx + mCtl.ListIndex
                               <span style="color:blue">If</span> idx >= 0 <span style="color:blue">Then</span> mCtl.ListIndex = idx
                                  <span style="color:blue">Exit</span> <span style="color:blue">Function</span>
                       <span style="color:blue">End</span> <span style="color:blue">If</span>
               <span style="color:blue">Else</span>
                       UnhookListBoxScroll
               <span style="color:blue">End</span> <span style="color:blue">If</span>
       <span style="color:blue">End</span> <span style="color:blue">If</span>
       MouseProc = CallNextHookEx( _
                               mLngMouseHook, nCode, wParam, <span style="color:blue">ByVal</span> lParam)
       <span style="color:blue">Exit</span> <span style="color:blue">Function</span>
  errH:
       UnhookListBoxScroll
  <span style="color:blue">End</span> <span style="color:blue">Function</span>
  <span style="color:green">'''''''' end normal module code</span>
  
  <span style="color:green">'http://social.Msdn.microsoft.com/Forums/en-US/isvvba/thread/7d584120-a929-4e7c-9ec2-9998ac639bea#7738fb96-12be-4e3c-af5c-abaae64a5e94</span>
  <span style="color:green">'</span>
  <span style="color:green">'19-Jul-2012</span>
  
  <span style="color:green">''''' Userform code</span>
  <span style="color:blue">Private</span> <span style="color:blue">Sub</span> comboBox1_MouseMove( _
                          <span style="color:blue">ByVal</span> Button <span style="color:blue">As</span> <span style="color:blue">Integer</span>, <span style="color:blue">ByVal</span> Shift <span style="color:blue">As</span> <span style="color:blue">Integer</span>, _
                          <span style="color:blue">ByVal</span> X <span style="color:blue">As</span> <span style="color:blue">Single</span>, <span style="color:blue">ByVal</span> Y <span style="color:blue">As</span> <span style="color:blue">Single</span>)
                  HookListBoxScroll <span style="color:blue">Me</span>, <span style="color:blue">Me</span>.ComboBox1
  <span style="color:blue">End</span> <span style="color:blue">Sub</span>
  
  <span style="color:blue">Private</span> <span style="color:blue">Sub</span> ListBox1_MouseMove( _
                          <span style="color:blue">ByVal</span> Button <span style="color:blue">As</span> <span style="color:blue">Integer</span>, <span style="color:blue">ByVal</span> Shift <span style="color:blue">As</span> <span style="color:blue">Integer</span>, _
                          <span style="color:blue">ByVal</span> X <span style="color:blue">As</span> <span style="color:blue">Single</span>, <span style="color:blue">ByVal</span> Y <span style="color:blue">As</span> <span style="color:blue">Single</span>)
           HookListBoxScroll <span style="color:blue">Me</span>, <span style="color:blue">Me</span>.ListBox1
  <span style="color:blue">End</span> <span style="color:blue">Sub</span>
  
  <span style="color:blue">Private</span> <span style="color:blue">Sub</span> ListBox2_MouseMove( _
                          <span style="color:blue">ByVal</span> Button <span style="color:blue">As</span> <span style="color:blue">Integer</span>, <span style="color:blue">ByVal</span> Shift <span style="color:blue">As</span> <span style="color:blue">Integer</span>, _
                          <span style="color:blue">ByVal</span> X <span style="color:blue">As</span> <span style="color:blue">Single</span>, <span style="color:blue">ByVal</span> Y <span style="color:blue">As</span> <span style="color:blue">Single</span>)
           HookListBoxScroll <span style="color:blue">Me</span>, <span style="color:blue">Me</span>.ListBox2
  <span style="color:blue">End</span> <span style="color:blue">Sub</span>
  <span style="color:blue">Private</span> <span style="color:blue">Sub</span> UserForm_Initialize()
  <span style="color:blue">Dim</span> i <span style="color:blue">As</span> <span style="color:blue">Long</span>
  <span style="color:blue">Dim</span> s <span style="color:blue">As</span> <span style="color:blue">String</span>
          s = <span style="color:#a31515">"this is line "</span>
          <span style="color:blue">For</span> i = 1 <span style="color:blue">To</span> 50
                          <span style="color:blue">Me</span>.ComboBox1.AddItem s & i
                          <span style="color:blue">Me</span>.ListBox1.AddItem s & i
                          <span style="color:blue">Me</span>.ListBox2.AddItem s & i
          <span style="color:blue">Next</span>
  <span style="color:blue">End</span> <span style="color:blue">Sub</span>
  <span style="color:blue">Private</span> <span style="color:blue">Sub</span> UserForm_QueryClose(Cancel <span style="color:blue">As</span> <span style="color:blue">Integer</span>, CloseMode <span style="color:blue">As</span> <span style="color:blue">Integer</span>)
          UnhookListBoxScroll
  <span style="color:blue">End</span> <span style="color:blue">Sub</span>
  <span style="color:green">''''''' end Userform code</span>
  
  

  You can delete the commented PostMessage code

  Peter Thornton

  Hi Peter,

  Can this code be adapted for to page scroll in a multipage object?

  regards,

  Mike

• > Can this code be adapted for to page scroll in a multipage object?

  In very light testing it seems easily adaptable for a multipage. Referring to the previous example (ie the code you quoted), in the normal module code, in Function MouseProc()…

  change
       idx = idx + mCtl.ListIndex
       If idx >= 0 Then mCtl.ListIndex = idx
  to
       idx = idx + mCtl.Value
       If idx >= 0 And idx < mCtl.Pages.Count Then
               mCtl.Value = idx
       End If

  In the userform add a similar mousemove for the multipage

  Private Sub MultiPage1_MouseMove(ByVal Index As Long, _
               ByVal Button As Integer, ByVal Shift As Integer, _
               ByVal X As Single, ByVal Y As Single)
          HookListBoxScroll Me, Me.MultiPage1
  End Sub

  Obviously change the name MultiPage1 to suit

  The multipage mousemove event will not fire if the mouse is over certain window’ed type controls, eg Listbox & Combo.

  If the code is to cater for both a multipage and  List/combo, a global flag could be set in HookListBoxScroll to indicate the control type, and in turn under an IF whether to process a multipage or List/Combo.

  As I said, I’ve barely tested. Fully test your scenario, scrolling while the mouse is over each control on each page for any unexpected catches.

  One thing I’d look at in more detail the check — If Not frm.ActiveControl Is ctl, etc — this was necessary in the original example, not sure if useful or possibly counter productive with the multipage.

  Peter Thornton

• Hi Peter,

  Many thanks for the prompt reply,

  I have applied sugested changes, however, this rotates through the pages, I whish to be able to apply mouse scrollability to a verticle scroll bar on a page in a multipage object,

  

  Just answered my own question, in Function MouseProc()…; changed the following to increments of 10 for faster scroll speed;

  If lParam.hwnd > 0 Then idx = -10 Else idx = 10

  And changed your suggestion to;

  idx = idx + mCtl.Item(mCtl.Value).ScrollTop
  If idx >= 0 And idx < ((mCtl.Item(mCtl.Value).ScrollHeight - mCtl.Height) + 17.25) Then
  	mCtl.Item(mCtl.Value).ScrollTop = idx
  End If

  Works a charm,

  Many thanks for the help,

  Regards,

  Mike

  • Proposed as answer by
    Triple_M
    Tuesday, August 21, 2012 8:55 AM
  • Unproposed as answer by
    Triple_M
    Tuesday, August 21, 2012 8:55 AM
  • Edited by
    Triple_M
    Tuesday, August 21, 2012 9:20 AM

• Ah, I misread precisely what you were asking for but it looks like you’ve got the idea how to adapt the approach!

  If you only want to enable mouse scroll on one or some of the multipages, in the multipage mousemove event include something like this, say for pages 0, 2, 3 and 6 only

  Dim bFlag As Boolean
       Select Case MultiPage1.Value
       Case 0, 2, 3, 6
               bFlag = True
       End Select
          If bFlag Then
               HookListBoxScroll Me, Me.MultiPage1
       End If

  Peter Thornton

• Hi Peter —

  Thanks a million for your solution.  I’m a so-so VBA programmer — and would never have been able to implement this on my own.  Your code proposed below works brilliantly on Excel 32bit, but as expected (and predicted by you) it doesn’t fare as
  well on 64 bit.  I have no experiences with API calls — outside of copying and pasting someone else’s code

  Any thoughts on getting this code to fail over to 64bit API’s so I might have a universal cross-platform solution?

  Thanks again…

  Christopher Gebo

• Christopher, glad you got it working. It took a while with a fair bit of trial and error!

  I don’t have Office-64 so I haven’t looked into converting code, apart than getting an overview. But why not have a go yourself. Start with Jan Karel Pieterse’s page
  http://www.jkp-ads.com/articles/apideclarations.asp

  I’m reasonably confident this mouse scroll code can be converted because there appear to be «PtrSafe» equivalents of all the APIs used, see the file Win32API_PtrSafe.TXT in this download
  http://www.microsoft.com/downloads/en/confirmation.aspx?FamilyID=035b72a5-eef9-4baf-8dbc-63fbd2dd982b&displaylang=en

  You could either make separate versions for Office 32/64 bit, or I assume it should be possible to make one version with liberal use of the conditional constant #If Win64 etc

  See how you get on and do post back with your progress, even if stumbling. Sooner or later I will have to adapt all my code so maybe you can save me some time with this lot

  Peter Thornton

  <gebo1> wrote in message news:47076a88-058d-4fbe-8d62-411d6c7dc9e1@communitybridge.codeplex.com…

  Hi Peter —

  Thanks a million for your solution. I’m a so-so VBA programmer — and would never have been able to implement this on my own. Your code proposed below works brilliantly on Excel 32bit, but as expected (and predicted by you) it doesn’t fare as well on 64 bit.
  I have no experiences with API calls — outside of copying and pasting someone else’s code

  Any thoughts on getting this code to fail over to 64bit API’s so I might have a universal cross-platform solution?

  Thanks again…

  Christopher Gebo

• Will do — thanks for the pointers in the right (?) direction

  Cheers!

• I know this post is not new, but certainly useful. If it would be possible to expand on it for a listbox on a worksheet, it sure would be appreciated. I have tried several things and the problem seems to be the handle for the worksheet. thanks, roger

  EDIT: Could that be a multiline textbox instead of a listbox. I just noticed the code above is strictly designed for a listbox.

  • Edited by
    rdwray_666
    Thursday, September 19, 2013 11:55 AM

• Hi Peter

  I found this quite useful, but I am having some difficulties applying it to my code. Reason being that I am not using a ComboBox or Listbox in a UserForm. Instead, I am inserting a ActiveX ControlBox. I am quite new to VB, not sure what are the main difference.
  Learning while writing as I go along. Appreciate if you can shed some light on how do I go about changing the code to accommodate this ComboBox.

  Thanks,

  Hugo

• I’m not here very often these days and only just seen your message, hope you’ve solved your problem if not post back.

  Peter Thornton

• Hi, sorry to dredge this up once again, however I’m trying to get this to work on a Frame within a userform and can’t find anything about scrolling frames anywhere.

  Basically I need some controls to remain static on the form, whilst others contained within the frame scroll using the mouse wheel.  Is there anyway your code solutions above can be adapted to frames?

  Thankyou!

• Yes Chris it works fine with a Frame to scroll embedded controls in/out of view, in fact that’s what I mainly use it for. Just adapt everything in the example(s) that refers to a listbox to your Frame, including the mouse move event.

• Hello Peter, to scroll userform you posted the below code in another topic, but I could not figure it out, can you post a complete code

  'In the declarations area
  Private mObj As Object 
  
  'change
  Sub HookListBoxScroll(frm As Object, , ctl As MSForms.Control)
  'to
  Sub HookListBoxScroll(frm As Object, obj As Object)
  
  'add new If
      If Not frm Is obj Then  ' new
          If Not frm.ActiveControl Is obj Then ' existing
              obj.SetFocus
          End If
      End If
  
  ' in MouseProc()
  If lParam.hwnd > 0 Then idx = -1 Else idx = 1 ' existing code
  
  ' new
  If TypeName(mObj) = "UserForm1" Or TypeName(mObj) = "Frame" Then
      If mObj.ScrollTop + idx * 9 <= 0 Then
          mObj.ScrollTop = 0
      Else
          mObj.ScrollTop = mObj.ScrollTop + idx * 9
      End If
  ElseIf TypeName(mObj) = "ListBox" Then
      idx = idx + mObj.ListIndex
      If idx >= 0 Then mObj.ListIndex = idx
      ' similar for a ComboBox
  ElseIf TypeName(mObj) = "MultiPage" Then
      ' this selects adjecent pages, but to scroll a page's
      ' scrollbar similar to a Frame or Form
      idx = idx + mObj.Value
      If idx >= 0 And idx < mObj.Pages.Count Then
          mObj.Value = idx
      End If
  End If
  
  Exit Function  ' existing code
  
  ' in UnhookListBoxScroll
  Set mObj = Nothing
  
  ' In the form
  Private Sub UserForm_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
      HookListBoxScroll Me, Me
  End Sub
  
  ' and similar in the mousemove events of other controls
  
  ' be sure to include this (you didn't in the file you uploaded)
  Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
      UnhookListBoxScroll
  End Sub

  I’ve made the code generic and as short as possible but better to adapt to the controls you have, replace
  mCtl as MSForms.Controls, include simple flags to direct which control or form should be handled in the MouseProc routine.

• Hello again,

  I think it should be possible to adapt the above into the original if you follow the instructions. If you get errors do Debug / Compile to flag anything which will not compile (ensure each module is headed ‘Option Explicit’).

  This is already an extremely long thread so probably better not to re-post the entire code again for what is only a few small changes to the original code to adapt for to different controls. See how you get on, if still stuck I’ll see if I can email it to
  you.

  • Proposed as answer by
    jdubei
    Thursday, August 28, 2014 9:21 PM
  • Unproposed as answer by
    jdubei
    Thursday, August 28, 2014 9:21 PM

• I am not very experienced with API calls, however, I was able to convert it for 64 bit and 32 bit with the help of the resources cited above. I tested the code in 3 different environments:
  Excel 2010 Version 14.0.7 (32bit) installed on Win 8 (64bit); Excel 2013 Version 15.0.4 (64 bit) installed on Win 7 (64 bit); and Excel 2013 Version 15.0.4 (64 bit) installed on Win 8 (64 bit). The code appears to be working on all 3 environments but it crashes
  after 1 min of scroll in last 2 environments (Excel 2013/64 bit). I am not sure if the problem is in the code below or anywhere else as I was testing it with a file that has a large amount of code. I will be doing more testing, however, if anyone has any suggestions
  at this point or has other versions/alternatives for using mouse scroll within a form, I would be very appreciative. I am not getting any error. Excel simply crashes with «Microsoft Excel has stopped working». Thanks, Joe.

  'Enables mouse wheel scrolling in controls
  Option Explicit
  
  #If Win64 Then
      Private Type POINTAPI
         XY As LongLong
      End Type
  #Else
      Private Type POINTAPI
             X As Long
             Y As Long
      End Type
  #End If
  
  Private Type MOUSEHOOKSTRUCT
      Pt As POINTAPI
      hWnd As Long
      wHitTestCode As Long
      dwExtraInfo As Long
  End Type
  
  #If VBA7 Then
      Private Declare PtrSafe Function FindWindow Lib "user32" _
                                              Alias "FindWindowA" ( _
                                                              ByVal lpClassName As String, _
                                                              ByVal lpWindowName As String) As Long ' not sure if this should be LongPtr
      #If Win64 Then
          Private Declare PtrSafe Function GetWindowLongPtr Lib "user32" _
                                              Alias "GetWindowLongPtrA" ( _
                                                              ByVal hWnd As LongPtr, _
                                                              ByVal nIndex As Long) As LongPtr
      #Else
          Private Declare PtrSafe Function GetWindowLong Lib "user32" _
                                              Alias "GetWindowLongA" ( _
                                                              ByVal hWnd As LongPtr, _
                                                              ByVal nIndex As Long) As LongPtr
      #End If
      Private Declare PtrSafe Function SetWindowsHookEx Lib "user32" _
                                              Alias "SetWindowsHookExA" ( _
                                                              ByVal idHook As Long, _
                                                              ByVal lpfn As LongPtr, _
                                                              ByVal hmod As LongPtr, _
                                                              ByVal dwThreadId As Long) As LongPtr
      Private Declare PtrSafe Function CallNextHookEx Lib "user32" ( _
                                                              ByVal hHook As LongPtr, _
                                                              ByVal nCode As Long, _
                                                              ByVal wParam As LongPtr, _
                                                             lParam As Any) As LongPtr
      Private Declare PtrSafe Function UnhookWindowsHookEx Lib "user32" ( _
                                                              ByVal hHook As LongPtr) As LongPtr ' MAYBE Long
      'Private Declare PtrSafe Function PostMessage Lib "user32.dll" _
      '                                         Alias "PostMessageA" ( _
      '                                                         ByVal hwnd As LongPtr, _
      '                                                         ByVal wMsg As Long, _
      '                                                         ByVal wParam As LongPtr, _
      '                                                         ByVal lParam As LongPtr) As LongPtr   ' MAYBE Long
      #If Win64 Then
          Private Declare PtrSafe Function WindowFromPoint Lib "user32" ( _
                                                              ByVal Point As LongLong) As LongPtr    '
      #Else
          Private Declare PtrSafe Function WindowFromPoint Lib "user32" ( _
                                                              ByVal xPoint As Long, _
                                                              ByVal yPoint As Long) As LongPtr    '
      #End If
      Private Declare PtrSafe Function GetCursorPos Lib "user32" ( _
                                                              ByRef lpPoint As POINTAPI) As LongPtr   'MAYBE Long
  #Else
      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
  #End If
  
  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
  Dim n As Long
  Private mCtl As MSForms.control
  Private mbHook As Boolean
  #If VBA7 Then
      Private mLngMouseHook As LongPtr
      Private mListBoxHwnd As LongPtr
  #Else
      Private mLngMouseHook As Long
      Private mListBoxHwnd As Long
  #End If
       
  Sub HookListBoxScroll(frm As Object, ctl As MSForms.control)
      Dim tPT As POINTAPI
      #If VBA7 Then
          Dim lngAppInst As LongPtr
          Dim hwndUnderCursor As LongPtr
      #Else
          Dim lngAppInst As Long
          Dim hwndUnderCursor As Long
      #End If
      GetCursorPos tPT
      #If Win64 Then
          hwndUnderCursor = WindowFromPoint(tPT.XY)
      #Else
          hwndUnderCursor = WindowFromPoint(tPT.X, tPT.Y)
      #End If
      If Not frm.ActiveControl Is ctl Then
             ctl.SetFocus
      End If
      If mListBoxHwnd <> hwndUnderCursor Then
          UnhookListBoxScroll
          Set mCtl = ctl
          mListBoxHwnd = hwndUnderCursor
          #If Win64 Then
              lngAppInst = GetWindowLongPtr(mListBoxHwnd, GWL_HINSTANCE)
          #Else
              lngAppInst = GetWindowLong(mListBoxHwnd, GWL_HINSTANCE)
          #End If
          ' 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
  #If VBA7 Then
      Private Function MouseProc( _
                              ByVal nCode As Long, ByVal wParam As Long, _
                              ByRef lParam As MOUSEHOOKSTRUCT) As LongPtr
          Dim idx As Long
          On Error GoTo errH
          If (nCode = HC_ACTION) Then
              #If Win64 Then
                  If WindowFromPoint(lParam.Pt.XY) = 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 TypeOf mCtl Is Frame Then
                              If lParam.hWnd > 0 Then idx = -10 Else idx = 10
                              idx = idx + mCtl.ScrollTop
                              If idx >= 0 And idx < ((mCtl.ScrollHeight - mCtl.Height) + 17.25) Then
                                  mCtl.ScrollTop = idx
                              End If
                          ElseIf TypeOf mCtl Is UserForm Then
                              If lParam.hWnd > 0 Then idx = -10 Else idx = 10
                              idx = idx + mCtl.ScrollTop
                              If idx >= 0 And idx < ((mCtl.ScrollHeight - mCtl.Height) + 17.25) Then
                                  mCtl.ScrollTop = idx
                              End If
                          Else
                              If lParam.hWnd > 0 Then idx = -1 Else idx = 1
                              idx = idx + mCtl.ListIndex
                              If idx >= 0 Then mCtl.ListIndex = idx
                          End If
                      Exit Function
                      End If
                  Else
                      UnhookListBoxScroll
                  End If
              #Else
                  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 TypeOf mCtl Is Frame Then
                              If lParam.hWnd > 0 Then idx = -10 Else idx = 10
                              idx = idx + mCtl.ScrollTop
                              If idx >= 0 And idx < ((mCtl.ScrollHeight - mCtl.Height) + 17.25) Then
                                  mCtl.ScrollTop = idx
                              End If
                          ElseIf TypeOf mCtl Is UserForm Then
                              If lParam.hWnd > 0 Then idx = -10 Else idx = 10
                              idx = idx + mCtl.ScrollTop
                              If idx >= 0 And idx < ((mCtl.ScrollHeight - mCtl.Height) + 17.25) Then
                                  mCtl.ScrollTop = idx
                              End If
                          Else
                              If lParam.hWnd > 0 Then idx = -1 Else idx = 1
                              idx = idx + mCtl.ListIndex
                              If idx >= 0 Then mCtl.ListIndex = idx
                          End If
                          Exit Function
                      End If
                  Else
                      UnhookListBoxScroll
                  End If
              #End If
          End If
          MouseProc = CallNextHookEx( _
                                  mLngMouseHook, nCode, wParam, ByVal lParam)
          Exit Function
  errH:
          UnhookListBoxScroll
      End Function
  #Else
      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 TypeOf mCtl Is Frame Then
                          If lParam.hWnd > 0 Then idx = -10 Else idx = 10
                          idx = idx + mCtl.ScrollTop
                          If idx >= 0 And idx < ((mCtl.ScrollHeight - mCtl.Height) + 17.25) Then
                              mCtl.ScrollTop = idx
                          End If
                      ElseIf TypeOf mCtl Is UserForm Then
                          If lParam.hWnd > 0 Then idx = -10 Else idx = 10
                          idx = idx + mCtl.ScrollTop
                          If idx >= 0 And idx < ((mCtl.ScrollHeight - mCtl.Height) + 17.25) Then
                              mCtl.ScrollTop = idx
                          End If
                      Else
                          If lParam.hWnd > 0 Then idx = -1 Else idx = 1
                          idx = idx + mCtl.ListIndex
                          If idx >= 0 Then mCtl.ListIndex = idx
                      End If
                      Exit Function
                  End If
              Else
                  UnhookListBoxScroll
              End If
          End If
          MouseProc = CallNextHookEx( _
          mLngMouseHook, nCode, wParam, ByVal lParam)
          Exit Function
  errH:
          UnhookListBoxScroll
      End Function
  #End If

  • Proposed as answer by
    jdubei
    Thursday, August 28, 2014 9:53 PM

• I have tested the code again using a simple form with a frame. It appears that the crashes I was encountering were caused by other reasons (possibly by using too many controls in the frame — 200 to 300). The code appears to be working fine on all
  three environments mentioned above. Joe.

• Hello jdubei, I tested the code with a simple form to scroll the userform, but I get type mismatch error, you can see the uploaded file here

  Thank you

• there are two variables defined as MSForms.Control — mctl and ctl (inside HookListBoxScroll sub). These have to be changed to object along with other small changes in order to have the code work with userform. see below.

  'Enables mouse wheel scrolling in controls
  Option Explicit
  
  #If Win64 Then
      Private Type POINTAPI
         XY As LongLong
      End Type
  #Else
      Private Type POINTAPI
             X As Long
             Y As Long
      End Type
  #End If
  
  Private Type MOUSEHOOKSTRUCT
      Pt As POINTAPI
      hWnd As Long
      wHitTestCode As Long
      dwExtraInfo As Long
  End Type
  
  #If VBA7 Then
      Private Declare PtrSafe Function FindWindow Lib "user32" _
                                              Alias "FindWindowA" ( _
                                                              ByVal lpClassName As String, _
                                                              ByVal lpWindowName As String) As Long ' not sure if this should be LongPtr
      #If Win64 Then
          Private Declare PtrSafe Function GetWindowLongPtr Lib "user32" _
                                              Alias "GetWindowLongPtrA" ( _
                                                              ByVal hWnd As LongPtr, _
                                                              ByVal nIndex As Long) As LongPtr
      #Else
          Private Declare PtrSafe Function GetWindowLong Lib "user32" _
                                              Alias "GetWindowLongA" ( _
                                                              ByVal hWnd As LongPtr, _
                                                              ByVal nIndex As Long) As LongPtr
      #End If
      Private Declare PtrSafe Function SetWindowsHookEx Lib "user32" _
                                              Alias "SetWindowsHookExA" ( _
                                                              ByVal idHook As Long, _
                                                              ByVal lpfn As LongPtr, _
                                                              ByVal hmod As LongPtr, _
                                                              ByVal dwThreadId As Long) As LongPtr
      Private Declare PtrSafe Function CallNextHookEx Lib "user32" ( _
                                                              ByVal hHook As LongPtr, _
                                                              ByVal nCode As Long, _
                                                              ByVal wParam As LongPtr, _
                                                             lParam As Any) As LongPtr
      Private Declare PtrSafe Function UnhookWindowsHookEx Lib "user32" ( _
                                                              ByVal hHook As LongPtr) As LongPtr ' MAYBE Long
      'Private Declare PtrSafe Function PostMessage Lib "user32.dll" _
      '                                         Alias "PostMessageA" ( _
      '                                                         ByVal hwnd As LongPtr, _
      '                                                         ByVal wMsg As Long, _
      '                                                         ByVal wParam As LongPtr, _
      '                                                         ByVal lParam As LongPtr) As LongPtr   ' MAYBE Long
      #If Win64 Then
          Private Declare PtrSafe Function WindowFromPoint Lib "user32" ( _
                                                              ByVal Point As LongLong) As LongPtr    '
      #Else
          Private Declare PtrSafe Function WindowFromPoint Lib "user32" ( _
                                                              ByVal xPoint As Long, _
                                                              ByVal yPoint As Long) As LongPtr    '
      #End If
      Private Declare PtrSafe Function GetCursorPos Lib "user32" ( _
                                                              ByRef lpPoint As POINTAPI) As LongPtr   'MAYBE Long
  #Else
      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
  #End If
  
  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
  Dim n As Long
  Private mCtl As Object
  Private mbHook As Boolean
  #If VBA7 Then
      Private mLngMouseHook As LongPtr
      Private mListBoxHwnd As LongPtr
  #Else
      Private mLngMouseHook As Long
      Private mListBoxHwnd As Long
  #End If
       
  Sub HookListBoxScroll(frm As Object, ctl As Object)
      Dim tPT As POINTAPI
      #If VBA7 Then
          Dim lngAppInst As LongPtr
          Dim hwndUnderCursor As LongPtr
      #Else
          Dim lngAppInst As Long
          Dim hwndUnderCursor As Long
      #End If
      GetCursorPos tPT
      #If Win64 Then
          hwndUnderCursor = WindowFromPoint(tPT.XY)
      #Else
          hwndUnderCursor = WindowFromPoint(tPT.X, tPT.Y)
      #End If
      If TypeOf ctl Is UserForm Then
          If Not frm Is ctl Then
                 ctl.SetFocus
          End If
      Else
          If Not frm.ActiveControl Is ctl Then
               ctl.SetFocus
          End If
      End If
      If mListBoxHwnd <> hwndUnderCursor Then
          UnhookListBoxScroll
          Set mCtl = ctl
          mListBoxHwnd = hwndUnderCursor
          #If Win64 Then
              lngAppInst = GetWindowLongPtr(mListBoxHwnd, GWL_HINSTANCE)
          #Else
              lngAppInst = GetWindowLong(mListBoxHwnd, GWL_HINSTANCE)
          #End If
          ' 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
  #If VBA7 Then
      Private Function MouseProc( _
                              ByVal nCode As Long, ByVal wParam As Long, _
                              ByRef lParam As MOUSEHOOKSTRUCT) As LongPtr
          Dim idx As Long
          On Error GoTo errH
          If (nCode = HC_ACTION) Then
              #If Win64 Then
                  If WindowFromPoint(lParam.Pt.XY) = 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 TypeOf mCtl Is Frame Then
                              If lParam.hWnd > 0 Then idx = -10 Else idx = 10
                              idx = idx + mCtl.ScrollTop
                              If idx >= 0 And idx < ((mCtl.ScrollHeight - mCtl.Height) + 17.25) Then
                                  mCtl.ScrollTop = idx
                              End If
                          ElseIf TypeOf mCtl Is UserForm Then
                              If lParam.hWnd > 0 Then idx = -10 Else idx = 10
                              idx = idx + mCtl.ScrollTop
                              If idx >= 0 And idx < ((mCtl.ScrollHeight - mCtl.Height) + 17.25) Then
                                  mCtl.ScrollTop = idx
                              End If
                          Else
                              If lParam.hWnd > 0 Then idx = -1 Else idx = 1
                              idx = idx + mCtl.ListIndex
                              If idx >= 0 Then mCtl.ListIndex = idx
                          End If
                      Exit Function
                      End If
                  Else
                      UnhookListBoxScroll
                  End If
              #Else
                  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 TypeOf mCtl Is Frame Then
                              If lParam.hWnd > 0 Then idx = -10 Else idx = 10
                              idx = idx + mCtl.ScrollTop
                              If idx >= 0 And idx < ((mCtl.ScrollHeight - mCtl.Height) + 17.25) Then
                                  mCtl.ScrollTop = idx
                              End If
                          ElseIf TypeOf mCtl Is UserForm Then
                              If lParam.hWnd > 0 Then idx = -10 Else idx = 10
                              idx = idx + mCtl.ScrollTop
                              If idx >= 0 And idx < ((mCtl.ScrollHeight - mCtl.Height) + 17.25) Then
                                  mCtl.ScrollTop = idx
                              End If
                          Else
                              If lParam.hWnd > 0 Then idx = -1 Else idx = 1
                              idx = idx + mCtl.ListIndex
                              If idx >= 0 Then mCtl.ListIndex = idx
                          End If
                          Exit Function
                      End If
                  Else
                      UnhookListBoxScroll
                  End If
              #End If
          End If
          MouseProc = CallNextHookEx( _
                                  mLngMouseHook, nCode, wParam, ByVal lParam)
          Exit Function
  errH:
          UnhookListBoxScroll
      End Function
  #Else
      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 TypeOf mCtl Is Frame Then
                          If lParam.hWnd > 0 Then idx = -10 Else idx = 10
                          idx = idx + mCtl.ScrollTop
                          If idx >= 0 And idx < ((mCtl.ScrollHeight - mCtl.Height) + 17.25) Then
                              mCtl.ScrollTop = idx
                          End If
                      ElseIf TypeOf mCtl Is UserForm Then
                          If lParam.hWnd > 0 Then idx = -10 Else idx = 10
                          idx = idx + mCtl.ScrollTop
                          If idx >= 0 And idx < ((mCtl.ScrollHeight - mCtl.Height) + 17.25) Then
                              mCtl.ScrollTop = idx
                          End If
                      Else
                          If lParam.hWnd > 0 Then idx = -1 Else idx = 1
                          idx = idx + mCtl.ListIndex
                          If idx >= 0 Then mCtl.ListIndex = idx
                      End If
                      Exit Function
                  End If
              Else
                  UnhookListBoxScroll
              End If
          End If
          MouseProc = CallNextHookEx( _
          mLngMouseHook, nCode, wParam, ByVal lParam)
          Exit Function
  errH:
          UnhookListBoxScroll
      End Function
  #End If
  
  
  
  

  • Proposed as answer by
    Ahmed Morsyy
    Friday, August 29, 2014 3:28 PM

• Thank you jdubei, that works perfect. I’m using Excel 2010 (32 bit) on windows 7 (64 bit).

  Can you change the speed of scrolling?

• how to use mouse wheel in excel 2010

  • Proposed as answer by
    pvieira28
    Sunday, September 28, 2014 11:06 AM

• I’ve only just seen recent posts in this thread

  Under the conditional #VBA7 there’s no need to copy an entire function twice purely for respective arguments and return declarations, simply lke this

  #If VBA7 Then
  Private Function MouseProc(ByVal nCode As Long, ByVal wParam As LongPtr, ByRef lParam As MOUSEHOOKSTRUCT) As Long
  #Else
  Private Function MouseProc(ByVal nCode As Long, ByVal wParam As Long, ByRef lParam As MOUSEHOOKSTRUCT) As Long
  #End If
  
  ' code
  
  End Sub

• Can you change the speed of scrolling?

  Instead of changing the position in units of one, increase (or decrease for up) the units by a suitable factor. You could hard code the «speed» factor or make it user configurable.

• Yep, still here! I heard there was a video about this but I haven’t seen it.

  Not sure what your compile error is but it should work fine in Word or any VBA app. I assume you’re not using 64bit Office, but if you are the APIs needs adapting for LongPtr and in one case for a LongLong.

  Probably something simple but if stuck upload your (non sensitive) file to a file sharing site, eg www.onedrive.com and I’ll have a look.

• Found the answer. It was in one of your later posts. It dealt with the long vs. longptr setting when programming in Word2013/64 bit.

  Thanks.

  Roy

• Hi Peter,

  I don’t know if the thread is still alive but here goes nothing..

  I used your code, and everything is working perfercly ! But I would like to make a small change and apparently I’m not able to do it by myself…

  I would like to enable the scroll feature but not in a Userform, directly in the worksheet.

  Can you help me with this ?

  Thanks for your time and for this great piece of work

  • Edited by
    Samuel Bolduc
    Tuesday, July 7, 2015 3:56 PM

• Samuel, well it it looks like you made the thread alive again

  I haven’t looked at adapting this to scroll a sheet but I’m sure it could do, bit of API work involved though. But the obvious question, as worksheets already scroll by default — why?

• Hi I know this post was from a year ago, but on the off chance you are still active.

  I have managed to get everything working with both the userform and the listbox being able to scroll. However when I scroll with the userform as well as the listbox, I am unable to unhook the mouse scroll and therefore no other programs can scroll until
  excel is closed at which point it freezes and restarts excel.

  If anyone knows how to fix this I would be most appreciative.

  Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
      UnhookListBoxScroll
      UnhookFormScroll
  End Sub

  This is what I am using currently

  • Edited by
    Kauket25
    Sunday, December 13, 2015 7:54 AM

• Yep, still here!

  You’ve obviously adapted things so without seeing your code hard to suggest where things are going wrong. However it looks like you’ve got two hook routines, that might be alright providing only one can ever be running at any one time. Always cancel one
  before starting the other.

  Probably better only to have one hook and adapt so it stops and starts to scroll whatever control or form is known to be under the mouse. That would mean changing objCt As Control to As Object.

• Hey thanks for getting back to me.

  I managed to figure it out by using a reference cell as to whether or not the MouseProc macro ran, that’s where I seemed to have my issue. Not very elegant but it works.

  However I then came up against a few more issues. When I had another workbook open it would say subscript out of range. So i then had to establish that it would only run when the workbook it originated in was the active workbook.

  So far I is working but I will just have to wait and see. I also didn’t have to change for 64 bit for userform scroll unlike when I needed it for the listbox. 

  Thankyou so much for taking the time to write this code in the first place, it was genius and a god send.

  Private Function MouseProc( _
      ByVal nCode As Long, ByVal wParam As Long, _
      ByRef lParam As MOUSEHOOKSTRUCT) As Long
  
  If ActiveWorkbook.Name Like "*Repair Log*" Then
  
      If Worksheets("REF DATA").Range("N2") = "Stop" Then
          UnhookFormscroll
          Exit Function
      Else
      
      On Error GoTo errH 'Resume Next
      If (nCode = HC_ACTION) Then
          Debug.Print "action"
          Debug.Print "right window"
          If wParam = WM_MOUSEWHEEL Then
              Debug.Print "mouse scroll"
              MouseProc = True
              If lParam.hwnd > 0 Then
                  mForm.ScrollTop = Application.Max(0, mForm.ScrollTop - cSCROLLCHANGE)
              Else
                  mForm.ScrollTop = Application.Min(mForm.ScrollHeight - mForm.InsideHeight, mForm.ScrollTop + cSCROLLCHANGE)
              End If
              Exit Function
          End If
      End If
  End If
      MouseProc = CallNextHookEx( _
      mLngMouseHook, nCode, wParam, ByVal lParam)
      Exit Function
  errH:
      UnhookFormscroll
  
  Else
      Exit Function
  
  End If
  
  End Function

• Thanks for your comments!

  About your workaround I don’t quite follow what’s going on but in theory it shouldn’t be needed, or at least not quite like that.  But as the saying goes if it works it works I suppose!

  In passing I wouldn’t use those app.Min & Max functions, just simple If..Else..If

• No worries they are well deserved. 

  About my workaround, it is odd because I am basically learning this stuff on the go and for some reason I can’t get the macro to unhook correctly. So when I try and then scroll in a different program or even in excel I can’t scroll with the mouse. 

  Also on a side note can this sort of code start to cause instability in windows? Ever since I started using the codes for mouse scroll, funny things have been happening. Excel seems to crash a lot too. It is almost as if when the userform is closed and the
  unhook is supposed to happen it doesn’t leaving the API’s still running or something.

  Did you mean take out the min & max completely? I’m not sure, I am beginner and a terrible one at that. But thanks for getting back to me.

• Indeed any error within the hook might crash Excel instantly without warning, normal error handling probably won’t help. Crashes can also occur while debugging and stepping through the code, that’s different but be prepared for it with backups while developing.

  To mitigate any slowdown do the minimum necessary to scroll your window and ideally nothing else, with 100% error free code! Also ensure the hook is cancelled when not needed, ie the mouse is not over the given window, but see next.

  I’m not sure why your hook is not being cancelled. The first step detects if the mouse is over the anticipated window and if not call the Unhook. But best also call the Unhook any time you know you want it cancelled just to be sure, not least when the main
  form closes.

  About those Min/Max, merely that calling what are effectively external Excel worksheet functions is more work than simply If a>b scroll-up Elseif a<b scroll-down.

• One more thing to add, I’m sure people have already figured this out.

  but in the MouseProc function the ListIndex needs to be checked to make sure the new index wont be greater then the max listindex. The way it is right now if the user scrolls (down) in a listbox and the listindex is already on the last line it will throw
  an error and then get unhooked in the error control, the user then cant scroll (up) as it has been unhooked.

  This can be handled a couple different ways and might not even be a problem depending on how you are hooking, but I like to limit errors as much as possible.

  its as simple of changing this in the MouseProc function

      If lParam.hWnd > 0 Then idx = -1 Else idx = 1
      idx = idx + mCtl.ListIndex
      If idx >= 0 Then mCtl.ListIndex = idx

  to this

      If lParam.hWnd > 0 Then idx = -1 Else idx = 1
      idx = idx + mCtl.ListIndex
      If idx >= 0 And idx <= mCtl.ListCount - 1 Then mCtl.ListIndex = idx

  obviously if your scroll speed jumps more then one index this will need changed a little.

  on another note this post is just amazing, never would have gotten it on my own.

  thanks everyone, the 64bit/32bit thing was huge.

• Peter —

  I used your code to successfully scroll a listbox in a userform that requires first selecting the choice in the listbox and then clicking an Ok button. But I have another userform that navigates the workbook and I’m having trouble employing the mouse scroll
  code with that one. The difference is that the navigation userform, which displays a list of visible worksheets, activates on a listbox_click event, firing off the code that takes the user to the selected sheet. The scroll works fine with the list while the
  form is up, but after clicking and going to the selected sheet (the navigation userform is unloaded, of course) the mouse wheel will not scroll the active sheet until the cursor is taken over the vertical scrollbar or up into the ribbon. A quick fly up there
  and then the sheet will scroll. But escape or clicking on various cells does nothing until the cursor is moved off the worksheet.

  I thought it was a simple matter of putting the unhook call in the code that is fired when the listbox is clicked, but no go. I’ve tried a few other ploys, but no joy. Any ideas? Thanks.

  • Edited by
    Markh_Joy
    Tuesday, March 8, 2016 9:47 PM
    editing

• Oops, just solved it: I was hiding the navigation userform, not unloading it. Unloading it did the trick. Obviously, because it was still «there» it retained the mouse hold. So to speak.

• Hi Peter!

  I checked your code and it works for my Listboxes and Comboboxes. However, I could not make it work for Textboxes. Would you be able to extend your expertise and refine the code to make it also work for Textboxes which some of us are also using? Would greatly
  appreciate your help on this matter. Hope to hear from you soon.

• The approach won’t work for a textbox, at least not directly. What you could do is put textbox in a Frame. Adjust the Frame’s size and scrollheight to suit, then size the textbox to the Frame’s scrollheight and scrollwidth.

  Initiate scroll in the texbox’s mousemove event but pass the Frame object. Then in the hook increment the object’s Scrolltop up or down by a suitable amount, say +/- 12 points.

• Hi Peter!

  The code proposed the 21st of August 2012 works perfectly for multipages, thanks! However I also have frames on some of the pages — how do I get the scroll to work on the multipage when the mouse is over a frame? Would really appreciate your help!

• In the Frame’s mousemove pass the either the Frame’s Parent to the setup routine , if you want to scroll the Page itself, or the Frame’s Parent.Parent if you want to scroll pages. Also of course in the Mutlipage’s mousemove pass the same object as no doubt
  you already are.

  However if you want to scroll the Frame, pass the Frame object in the Frame’s mousemove.

  Obviously, depending on what you are scrolling in the Hook itself adapt the code to change the scrollTop (of the Page or Frame), or the MultiPage Value to scroll to different pages. but don’t attempt to scroll beyond the limits.

• Hi

  I have a problem with that script on Excel 2007. When I want to scroll Frame and take mouse on frame, mouse is freeze but scroll is working and there is problem to take out mouse from frame. Where is the problem ??

  On one Excel 2007 is working on another don’t (working on build nr …..43 …. SP….43 but on build nr …..47 …. SP …..43 it won’t)

  Same problem is with a combobox — it won’t show list in combobox only freeze a combobox

• On one Excel 2007 is working on another don’t (working on build nr …..43 …. SP….43 but on build nr …..47 …. SP …..43 it won’t)

  Without access to your machine I can’t give a suggestion, it sounds like there’s something different with the mouse itself and/or driver in the different systems. I doubt the difference is related to the Excel build number.

  • Edited by
    Peter Thornton (Excel MVP 2008-13)
    Wednesday, April 27, 2016 11:06 AM

• I need help.

  Please i have very basic understanding of VBA. Can someone post the full code for a 64bit machine. So i can get the scroll working on my userform and combo box please. I know i resurrecting this thread but it is the only one i have seen with a good amount
  of response. Please help me!

• I second that. So much info. Could someone please post the userform listbox combobox wheel scroll for 64 bit Windows 10 and 32 bit MS Office?

  • Edited by
    Sven622
    Wednesday, August 10, 2016 2:59 AM

• Master Peter,

  I’m trying to do something similar but can’t seem to figure out the necessary modifications.  I have a bunch of combo boxes in a worksheet (not form or userform) that I would like to be able to use the mouse wheel to scroll through (the combo box options
  instead of the sheet itself).  Any ideas?  I’m using Windows 7 x64 and Office 10 x32.  Thanks.

• From memory ActiveX comboboxes don’t expose a window when on Worksheets as they do when on a form (unlike some other controls like ListBox which IIRC do). If so it won’t be possible to adapt this scroll code.

  If you’re working with stuff like this I’ll assume you’ll know enough about APIs to get your worksheet’s window handle (classname: «EXCEL7», caption: Worksheet name), then get all it’s child windows looking for a classname that includes «60000000»
  (actual name differs with versions). 

  Also try with a ListBox and a Frame on the sheet which should have similar classname windows

• I came across this code while researching the same issue … just want to thank everyone especially Peter to make this available. It was an interesting read! 

• Thank you very much Peter Thornton for your efforts and for publishing your code in July 2012.
  I discovered your code when I was looking for scrolling a list in a listbox in 2013. Wow!

  And also many thanks to all who contributed in the 32bit / 64bit discussion.

  This is amazing!!!  I still make grateful use of it.

  With regards,
  Rü

• Hello Rü,

  Glad people are still finding it useful!

  Be careful with 64bit though, much more prone to problems if not implemented correctly, including anything else not obviously related that might error while the hook is running.

• OMG ……..A over five year software discussion. I am elated. Long live ExcelVBA….also I propose this mouse to be hereafter named «MIGHTYMOUSE THORNTON». For he surely saved my day

• Hi all,

  First thing thank you for those wonderful searches and explanations.

  I’m not a VBA expert but I think I managed to implement this code correctly inside my project.

  However I do receive the «Compile error: Argument not optional» on the following piece of listbox code when mouse point on it:

  Private Sub ListBox1_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, _
               ByVal X As Single, ByVal Y As Single)
               
  If Not Me.ActiveControl Is Me.ListBox1 Then
      Me.ListBox1.SetFocus
  End If
  
  HookListBoxScroll
  
  End Sub

  Here below the procedure which seems to make trouble:

  Sub HookListBoxScroll(frm As Object, ctl As Object)
      Dim tPT As POINTAPI
      #If VBA7 Then
          Dim lngAppInst As LongPtr
          Dim hwndUnderCursor As LongPtr
      #Else
          Dim lngAppInst As Long
          Dim hwndUnderCursor As Long
      #End If
      GetCursorPos tPT
      #If Win64 Then
          hwndUnderCursor = WindowFromPoint(tPT.XY)
      #Else
          hwndUnderCursor = WindowFromPoint(tPT.X, tPT.Y)
      #End If
      If TypeOf ctl Is UserForm Then
          If Not frm Is ctl Then
                 ctl.SetFocus
          End If
      Else
          If Not frm.ActiveControl Is ctl Then
               ctl.SetFocus
          End If
      End If
      If mListBoxHwnd <> hwndUnderCursor Then
          UnhookListBoxScroll
          Set mCtl = ctl
          mListBoxHwnd = hwndUnderCursor
          #If Win64 Then
              lngAppInst = GetWindowLongPtr(mListBoxHwnd, GWL_HINSTANCE)
          #Else
              lngAppInst = GetWindowLong(mListBoxHwnd, GWL_HINSTANCE)
          #End If
          
          If Not mbHook Then
              mLngMouseHook = SetWindowsHookEx( _
                                              WH_MOUSE_LL, AddressOf MouseProc, lngAppInst, 0)
              mbHook = mLngMouseHook <> 0
          End If
      End If
  End Sub

  Has anyone faced the same issue and eventually came with a fix?

  Thanks in advance

  • Edited by
    Nicolas Manin
    Monday, November 13, 2017 12:53 PM

• Looking only at the code you posted you would indeed get a compile error trying to call HookListBoxScroll without incuding the two non optional arguments. Try this —

  Call HookListBoxScroll(Me, Me.ListBox1)

• Hi Peter, thanks for the quick reply.

  I’m not familiar yet with all the argument thing so I was not able to see this myself… It seems to be fine.

  Now I get the following error:

  «run time error 453: can’t find dll entry point in user32.dll» for the first one and in «User32» for the second one

  on the two following functions:

  lngAppInst = GetWindowLong(mListBoxHwnd, GWL_HINSTANCE)
  
  &
  
  mLngMouseHook = SetWindowsHookEx(WH_MOUSE_LL, AddressOf MouseProc, lngAppInst, 0)

  As I’m not administrator on this machine I guess I can’t fix this DLL issue.

  In this case I will wait to be home to try to figure out what is wrong with my User32.DLL

  Am I correct? or is it due to the code itself?

  Have a good day!

  FYI, here below the full code inserted in a normal module (basically a copy paste from what I’ve found in this discussion):

  Option Explicit
  
  #If Win64 Then
      Private Type POINTAPI
         XY As LongLong
      End Type
  #Else
      Private Type POINTAPI
             X As Long
             Y As Long
      End Type
  #End If
  
  Private Type MOUSEHOOKSTRUCT
      Pt As POINTAPI
      hWnd As Long
      wHitTestCode As Long
      dwExtraInfo As Long
  End Type
  
  #If VBA7 Then
      Private Declare PtrSafe Function FindWindow Lib "user32" _
                                              Alias "FindWindowA" ( _
                                                              ByVal lpClassName As String, _
                                                              ByVal lpWindowName As String) As Long
      #If Win64 Then
          Private Declare PtrSafe Function GetWindowLongPtr Lib "user32" _
                                              Alias "GetWindowLongPtrA" ( _
                                                              ByVal hWnd As LongPtr, _
                                                              ByVal nIndex As Long) As LongPtr
      #Else
          Private Declare PtrSafe Function GetWindowLong Lib "user32" _
                                              Alias "GetWindowLongA" ( _
                                                              ByVal hWnd As LongPtr, _
                                                              ByVal nIndex As Long) As LongPtr
      #End If
      Private Declare PtrSafe Function SetWindowsHookEx Lib "user32" _
                                              Alias "SetWindowsHookExA" ( _
                                                              ByVal idHook As Long, _
                                                              ByVal lpfn As LongPtr, _
                                                              ByVal hmod As LongPtr, _
                                                              ByVal dwThreadId As Long) As LongPtr
      Private Declare PtrSafe Function CallNextHookEx Lib "user32" ( _
                                                              ByVal hHook As LongPtr, _
                                                              ByVal nCode As Long, _
                                                              ByVal wParam As LongPtr, _
                                                             lParam As Any) As LongPtr
      Private Declare PtrSafe Function UnhookWindowsHookEx Lib "user32" ( _
                                                              ByVal hHook As LongPtr) As LongPtr
      #If Win64 Then
          Private Declare PtrSafe Function WindowFromPoint Lib "user32" ( _
                                                              ByVal Point As LongLong) As LongPtr
      #Else
          Private Declare PtrSafe Function WindowFromPoint Lib "user32" ( _
                                                              ByVal xPoint As Long, _
                                                              ByVal yPoint As Long) As LongPtr
      #End If
      Private Declare PtrSafe Function GetCursorPos Lib "user32" ( _
                                                              ByRef lpPoint As POINTAPI) As LongPtr
  #Else
      Private Declare Function FindWindow Lib "user32" ()
      Private Declare Function GetWindowLong Lib "user32.dll" ()
      Private Declare Function SetWindowsHookEx Lib "user32" ()
      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 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
  #End If
  
  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)
  Dim n As Long
  Private mCtl As Object
  Private mbHook As Boolean
  #If VBA7 Then
      Private mLngMouseHook As LongPtr
      Private mListBoxHwnd As LongPtr
  #Else
      Private mLngMouseHook As Long
      Private mListBoxHwnd As Long
  #End If
  
  Sub HookListBoxScroll(frm As Object, ctl As Object)
      Dim tPT As POINTAPI
      #If VBA7 Then
          Dim lngAppInst As LongPtr
          Dim hwndUnderCursor As LongPtr
      #Else
          Dim lngAppInst As Long
          Dim hwndUnderCursor As Long
      #End If
      GetCursorPos tPT
      #If Win64 Then
          hwndUnderCursor = WindowFromPoint(tPT.XY)
      #Else
          hwndUnderCursor = WindowFromPoint(tPT.X, tPT.Y)
      #End If
      If TypeOf ctl Is UserForm Then
          If Not frm Is ctl Then
                 ctl.SetFocus
          End If
      Else
          If Not frm.ActiveControl Is ctl Then
               ctl.SetFocus
          End If
      End If
      If mListBoxHwnd <> hwndUnderCursor Then
          UnhookListBoxScroll
          Set mCtl = ctl
          mListBoxHwnd = hwndUnderCursor
          #If Win64 Then
              lngAppInst = GetWindowLongPtr(mListBoxHwnd, GWL_HINSTANCE)
          #Else
              lngAppInst = GetWindowLong(mListBoxHwnd, GWL_HINSTANCE)
          #End If
          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
  #If VBA7 Then
      Private Function MouseProc(ByVal nCode As Long, ByVal wParam As Long, _
                              ByRef lParam As MOUSEHOOKSTRUCT) As LongPtr
          Dim idx As Long
          On Error GoTo errH
          If (nCode = HC_ACTION) Then
              #If Win64 Then
                  If WindowFromPoint(lParam.Pt.XY) = mListBoxHwnd Then
                      If wParam = WM_MOUSEWHEEL Then
                          MouseProc = True
                          If TypeOf mCtl Is Frame Then
                              If lParam.hWnd > 0 Then idx = -10 Else idx = 10
                              idx = idx + mCtl.ScrollTop
                              If idx >= 0 And idx < ((mCtl.ScrollHeight - mCtl.Height) + 17.25) Then
                                  mCtl.ScrollTop = idx
                              End If
                          ElseIf TypeOf mCtl Is UserForm Then
                              If lParam.hWnd > 0 Then idx = -10 Else idx = 10
                              idx = idx + mCtl.ScrollTop
                              If idx >= 0 And idx < ((mCtl.ScrollHeight - mCtl.Height) + 17.25) Then
                                  mCtl.ScrollTop = idx
                              End If
                          Else
                              If lParam.hWnd > 0 Then idx = -1 Else idx = 1
                              idx = idx + mCtl.ListIndex
                              If idx >= 0 And idx <= mCtl.ListCount - 1 Then mCtl.ListIndex = idx
                          End If
                      Exit Function
                      End If
                  Else
                      UnhookListBoxScroll
                  End If
              #Else
                  If WindowFromPoint(lParam.Pt.X, lParam.Pt.Y) = mListBoxHwnd Then
                      If wParam = WM_MOUSEWHEEL Then
                          MouseProc = True
                          If TypeOf mCtl Is Frame Then
                              If lParam.hWnd > 0 Then idx = -10 Else idx = 10
                              idx = idx + mCtl.ScrollTop
                              If idx >= 0 And idx < ((mCtl.ScrollHeight - mCtl.Height) + 17.25) Then
                                  mCtl.ScrollTop = idx
                              End If
                          ElseIf TypeOf mCtl Is UserForm Then
                              If lParam.hWnd > 0 Then idx = -10 Else idx = 10
                              idx = idx + mCtl.ScrollTop
                              If idx >= 0 And idx < ((mCtl.ScrollHeight - mCtl.Height) + 17.25) Then
                                  mCtl.ScrollTop = idx
                              End If
                          Else
                              If lParam.hWnd > 0 Then idx = -1 Else idx = 1
                              idx = idx + mCtl.ListIndex
                              If idx >= 0 Then mCtl.ListIndex = idx
                          End If
                          Exit Function
                      End If
                  Else
                      UnhookListBoxScroll
                  End If
              #End If
          End If
          MouseProc = CallNextHookEx( _
                                  mLngMouseHook, nCode, wParam, ByVal lParam)
          Exit Function
  errH:
          UnhookListBoxScroll
      End Function
  #Else
      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 TypeOf mCtl Is Frame Then
                          If lParam.hWnd > 0 Then idx = -10 Else idx = 10
                          idx = idx + mCtl.ScrollTop
                          If idx >= 0 And idx < ((mCtl.ScrollHeight - mCtl.Height) + 17.25) Then
                              mCtl.ScrollTop = idx
                          End If
                      ElseIf TypeOf mCtl Is UserForm Then
                          If lParam.hWnd > 0 Then idx = -10 Else idx = 10
                          idx = idx + mCtl.ScrollTop
                          If idx >= 0 And idx < ((mCtl.ScrollHeight - mCtl.Height) + 17.25) Then
                              mCtl.ScrollTop = idx
                          End If
                      Else
                          If lParam.hWnd > 0 Then idx = -1 Else idx = 1
                          idx = idx + mCtl.ListIndex
                          If idx >= 0 Then mCtl.ListIndex = idx
                      End If
                      Exit Function
                  End If
              Else
                  UnhookListBoxScroll
              End If
          End If
          MouseProc = CallNextHookEx( _
          mLngMouseHook, nCode, wParam, ByVal lParam)
          Exit Function
  errH:
          UnhookListBoxScroll
      End Function
  #End If

  • Edited by
    Nicolas Manin
    Tuesday, November 14, 2017 8:06 AM

• Either you didn’t copy/paste correctly or the source is incorrect but the following declarations in the following APIs declared in the not VBA7 section are incomplete, no arguments

  #IF VBA7
  ‘ 
  #Else
  FindWindow, GetWindowLong and SetWindowsHookEx
  #End If

  Examples of what you copied is included several times in this thread in which you can find the correct declarations.

  I don’t want to discourage you but what’s being implemented here is a kind of low level hook which, if not understood and adapted correctly for the overall scenario, can easily lead to complete crashes with no warning. x64 is particularly sensitive and,
  even though the declarations look correct in theory, will likely need additional work to work reliably.

• Hi Peter,

  Once again you were right and I managed to get it working.

  Somehow part of my code was commented (the alias for Findwindow, Getwindowlong and Setwindowshookex).

  Have a very good day and thanks again

• Hi Peter,

  I really hope I can resurrect this sub one more time and get your attention!  I have code I found online (can’t remember exactly where) that I believe is an offshoot of your original code found in this thread.  The code works great for my ComboBoxes,
  but I can’t get it to UnHook the mouse and return to regular behavior once the Userform is terminated.  Could you please look at the below code and help figure out how to get the UnHook portion of the code to work?

  Regular Module Code:

  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 ForwardBacward 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 SkillChange_Begin.Controls(Worksheets("Skill Change Detail").Range("AV2").Value)
             
                '\ 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
  
  

  Userform Code:

  Private Sub Skill1_1_DropButtonClick()
  
  Worksheets("Skill Change Detail").Range("AV2").Value = SkillChange_Begin _
  .Frame31.ActiveControl.Name
  intTopIndex = Skill1_1.TopIndex
  Hook_Mouse
  
  End Sub
  
  Private Sub UserForm_Terminate()
  
  UnHook_Mouse
  
  End Sub
  

• Upon further research of the inner workings of these API calls, I discovered that the SetWindowsHookEx function sets a hook in place to monitor the mouse usage; this hook is deemed by a numeric value. In order to remove this hook, you must use the complimentary
  UnhookWindowsHookEx function and the numeric value assigned during the initial hook with the SetWindowsHookEx function.  There is no way of knowing this numeric value (that I could figure out) in order to release the hook, so I just devised the simple
  code below which does the trick:

  Sub UnHook_Mouse()
  
  Dim L1 As Long
  
  For L1 = 1 To 10000
      UnhookWindowsHookEx L1
  Next L1
  
  End Sub

• Indeed the hook should be released with UnhookWindowsHookEx and as you say with a pointer to the handle of the hook. 

  But no need for that 1 to 10000 loop. You might release some other hook though typically the value is likely to be be much more than 10000. This pointer will have been returned by SetWindowsHookEx when the hook ws established, so simply store the pointer and
  use it to release ‘your’ hook.

  Note the following in the first example I posted near the top of this very long thread:

  Private mLngMouseHook As Long  ‘ stored at module level

  mLngMouseHook = SetWindowsHookEx ‘ create the hook and store its handle

  UnhookWindowsHookEx mLngMouseHook ‘ release the hook

• Hey Peter,

  You are correct…using the for loop is in fact releasing a hook that is associated w/ another app and messing it up. I just can’t figure out how to get the right pointer used in creating the mouse wheel hook. Isn’t the code below doing what you suggested
  above, regarding storing the pointer and then using it in the UnhookWindowsHookEx function? Because it does not restore the default mouse wheel function.

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

• I didn’t look at the code you found somewhere else on line, apparently an offshoot of my original examples here. They’ve been widely reposted, as-is or adapted, sometimes with attribution but often without, sometimes even claiming copyright!

  But I’ve looked at it now. It does look like an ‘offshoot’ as it includes some specifics of what I posted here. But it seems to be standard mouse hook and little else, in particular without the functionality I included to handle the few MSForms controls that
  have windows, albeit not directly accessible.

  In simple terms it goes something like this —

  When the mouse is over the control, its mousemove event looks to start the hook, but if the hook is already running (if not mbHook)

  When starting the hook, get the control’s window pointer handle assuming it’s the window under the cursor at that moment, WindowFromPoint. There’s more that should be done to be 100% sure got the right window (not included in my original example).

  In each callback check the cursor is still over the given control window, WindowFromPoint. If not terminate the hook, this aspect is important. The hook will start again same way if the mouse moves back over the control. In your code it looks like that’s your
  «Frame31»

  Despite the mbHook flag I wonder if you are starting new hooks multiple times while an an existing hook is still running, maybe the flag and pointer are losing scope somehow. If so that would explain why your 1-10000 loop appeared to work, and why your ‘UnhookWindowsHookEx
  hhkLowLevelMouse’ apparantely fails, because other hooks are still running.

  To test, debug each new hook pointer in the Hook_Mouse and similarly in the UnHook_Mouse, there shold be matching consecutive pairs. Could do debug.? to the immediate window, or to cells, even to a log file.

• Sorry for making infinite this thread. I have used the Peter Thornton code modified by jdubei and Ahmed Morsyy for the mouse wheel to work in all environments but Excel closes when putting the cursor over the control without giving an error. It only closes.
  (Excel 2016 MSO (16.0.10827.20150) 64 bits and Windows 10 Pro x64)

  Line that causes the error is in the last IF of Sub HookListBoxScroll:
      mLngMouseHook = SetWindowsHookEx (WH_MOUSE_LL, AddressOf MouseProc, lngAppInst, 0)

  Can someone give me a clue as to what may be happening? with this configuration it works without problems: Excel Office 365 MSO (16.0.11001.20033) 32 bits and Windows 10 Home x64

  My code

  Option Explicit
  
  #If Win64 Then
      Private Type POINTAPI
         XY As LongLong
      End Type
  #Else
      Private Type POINTAPI
             X As Long
             Y As Long
      End Type
  #End If
  
  Private Type MOUSEHOOKSTRUCT
      Pt As POINTAPI
      hWnd As Long
      wHitTestCode As Long
      dwExtraInfo As Long
  End Type
  
  #If VBA7 Then
      Private Declare PtrSafe Function FindWindow Lib "user32" _
                                              Alias "FindWindowA" ( _
                                                              ByVal lpClassName As String, _
                                                              ByVal lpWindowName As String) As LongPtr
      #If Win64 Then
          Private Declare PtrSafe Function GetWindowLongPtr Lib "user32" _
                                              Alias "GetWindowLongPtrA" ( _
                                                              ByVal hWnd As LongPtr, _
                                                              ByVal nIndex As Long) As LongPtr
      #Else
          Private Declare PtrSafe Function GetWindowLong Lib "user32" _
                                              Alias "GetWindowLongA" ( _
                                                              ByVal hWnd As LongPtr, _
                                                              ByVal nIndex As Long) As LongPtr
      #End If
      Private Declare PtrSafe Function SetWindowsHookEx Lib "user32" _
                                              Alias "SetWindowsHookExA" ( _
                                                              ByVal idHook As Long, _
                                                              ByVal lpfn As LongPtr, _
                                                              ByVal hmod As LongPtr, _
                                                              ByVal dwThreadId As Long) As LongPtr
      Private Declare PtrSafe Function CallNextHookEx Lib "user32" ( _
                                                              ByVal hHook As LongPtr, _
                                                              ByVal nCode As Long, _
                                                              ByVal wParam As LongPtr, _
                                                             lParam As Any) As LongPtr
      Private Declare PtrSafe Function UnhookWindowsHookEx Lib "user32" ( _
                                                              ByVal hHook As LongPtr) As Long
      'Private Declare PtrSafe Function PostMessage Lib "user32.dll" _
      '                                         Alias "PostMessageA" ( _
      '                                                         ByVal hwnd As LongPtr, _
      '                                                         ByVal wMsg As Long, _
      '                                                         ByVal wParam As LongPtr, _
      '                                                         ByVal lParam As LongPtr) As Long
      #If Win64 Then
          Private Declare PtrSafe Function WindowFromPoint Lib "user32" ( _
                                                              ByVal Point As LongLong) As LongPtr
      #Else
          Private Declare PtrSafe Function WindowFromPoint Lib "user32" ( _
                                                              ByVal xPoint As Long, _
                                                              ByVal yPoint As Long) As LongPtr
      #End If
      Private Declare PtrSafe Function GetCursorPos Lib "user32" ( _
                                                              ByRef lpPoint As POINTAPI) As Long
  #Else
      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 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
  #End If
  
  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
  Dim n As Long
  Private mCtl As Object
  Private mbHook As Boolean
  #If VBA7 Then
      Private mLngMouseHook As LongPtr
      Private mListBoxHwnd As LongPtr
  #Else
      Private mLngMouseHook As Long
      Private mListBoxHwnd As Long
  #End If
       
  Sub HookListBoxScroll(frm As Object, ctl As Object)
      Dim tPT As POINTAPI
      #If VBA7 Then
          Dim lngAppInst As LongPtr
          Dim hwndUnderCursor As LongPtr
      #Else
          Dim lngAppInst As Long
          Dim hwndUnderCursor As Long
      #End If
      GetCursorPos tPT
      #If Win64 Then
          hwndUnderCursor = WindowFromPoint(tPT.XY)
      #Else
          hwndUnderCursor = WindowFromPoint(tPT.X, tPT.Y)
      #End If
      If TypeOf ctl Is UserForm Then
          If Not frm Is ctl Then
                 ctl.SetFocus
          End If
      Else
          If Not frm.ActiveControl Is ctl Then
               ctl.SetFocus
          End If
      End If
      If mListBoxHwnd <> hwndUnderCursor Then
          UnhookListBoxScroll
          Set mCtl = ctl
          mListBoxHwnd = hwndUnderCursor
          #If Win64 Then
              lngAppInst = GetWindowLongPtr(mListBoxHwnd, GWL_HINSTANCE)
          #Else
              lngAppInst = GetWindowLong(mListBoxHwnd, GWL_HINSTANCE)
          #End If
          ' 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
  
  #If VBA7 Then
  Private Function MouseProc(ByVal nCode As Long, ByVal wParam As LongPtr, ByRef lParam As MOUSEHOOKSTRUCT) As Long
  #Else
  Private Function MouseProc(ByVal nCode As Long, ByVal wParam As Long, ByRef lParam As MOUSEHOOKSTRUCT) As Long
  #End If
          Dim idx As Long
          On Error GoTo errH
          If (nCode = HC_ACTION) Then
              #If Win64 Then
                  If WindowFromPoint(lParam.Pt.XY) = 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 TypeOf mCtl Is Frame Then
                              If lParam.hWnd > 0 Then idx = -10 Else idx = 10
                              idx = idx + mCtl.ScrollTop
                              If idx >= 0 And idx < ((mCtl.ScrollHeight - mCtl.Height) + 17.25) Then
                                  mCtl.ScrollTop = idx
                              End If
                          ElseIf TypeOf mCtl Is UserForm Then
                              If lParam.hWnd > 0 Then idx = -10 Else idx = 10
                              idx = idx + mCtl.ScrollTop
                              If idx >= 0 And idx < ((mCtl.ScrollHeight - mCtl.Height) + 17.25) Then
                                  mCtl.ScrollTop = idx
                              End If
                          Else
                              If lParam.hWnd > 0 Then idx = -1 Else idx = 1
                              idx = idx + mCtl.ListIndex
                              If idx >= 0 Then mCtl.ListIndex = idx
                          End If
                      Exit Function
                      End If
                  Else
                      UnhookListBoxScroll
                  End If
              #Else
                  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 TypeOf mCtl Is Frame Then
                              If lParam.hWnd > 0 Then idx = -10 Else idx = 10
                              idx = idx + mCtl.ScrollTop
                              If idx >= 0 And idx < ((mCtl.ScrollHeight - mCtl.Height) + 17.25) Then
                                  mCtl.ScrollTop = idx
                              End If
                          ElseIf TypeOf mCtl Is UserForm Then
                              If lParam.hWnd > 0 Then idx = -10 Else idx = 10
                              idx = idx + mCtl.ScrollTop
                              If idx >= 0 And idx < ((mCtl.ScrollHeight - mCtl.Height) + 17.25) Then
                                  mCtl.ScrollTop = idx
                              End If
                          Else
                              If lParam.hWnd > 0 Then idx = -1 Else idx = 1
                              idx = idx + mCtl.ListIndex
                              If idx >= 0 Then mCtl.ListIndex = idx
                          End If
                          Exit Function
                      End If
                  Else
                      UnhookListBoxScroll
                  End If
              #End If
          End If
          MouseProc = CallNextHookEx(mLngMouseHook, nCode, wParam, ByVal lParam)
          Exit Function
  errH:
          UnhookListBoxScroll
  End Function
  

• Sorry for making infinite this thread. I have used the Peter Thornton code modified by jdubei and Ahmed Morsyy for the mouse wheel to work in all environments but Excel closes when putting the cursor over the control without giving an error. It
  only closes. (Excel 2016 MSO (16.0.10827.20150) 64 bits and Windows 10 Pro x64)

  Line that causes the error is in the last IF of Sub HookListBoxScroll:
      mLngMouseHook = SetWindowsHookEx (WH_MOUSE_LL, AddressOf MouseProc, lngAppInst, 0)

  Can someone give me a clue as to what may be happening? with this configuration it works without problems: Excel Office 365 MSO (16.0.11001.20033) 32 bits and Windows 10 Home x64

  Mario, 

  The code you posted fails to compile for me in x64 with a mismatch error on this line

  MouseProc = CallNextHookEx(mLngMouseHook, nCode, wParam, ByVal lParam)

  To fix change the return declaration of MouseProc from As Long to As Long for the #If VBA7 version, to match what CallNextHookEx returns.

  With that fix the code works for me in x64 Office. But x64 is extremely sensitive, it can work fine in most systems most of the time but fail in some for no obvious reason. In my apps I have made many changes to minimize such issues. (32x Office in Win64
  is much more stable)

  Your problem —

  mLngMouseHook = SetWindowsHookEx (WH_MOUSE_LL, AddressOf MouseProc, lngAppInst, 0)

  As I say, that works for me and I don’t know why it doesn’t for you. The only thing that stands out is the ‘0’. Normally that should be OK and its Type will coerce to a Long but wouldn’t include it like that. Try changing it to 0& which will explicitly
  change it from an Integer to a Long to match the dwThreadId declaration in the API

• Sorry for making infinite this thread. I have used the Peter Thornton code modified by jdubei and Ahmed Morsyy for the mouse wheel to work in all environments but Excel closes when putting the cursor over the control without giving an error. It only closes.
  (Excel 2016 MSO (16.0.10827.20150) 64 bits and Windows 10 Pro x64)

  Line that causes the error is in the last IF of Sub HookListBoxScroll:
      mLngMouseHook = SetWindowsHookEx (WH_MOUSE_LL, AddressOf MouseProc, lngAppInst, 0)

  Can someone give me a clue as to what may be happening? with this configuration it works without problems: Excel Office 365 MSO (16.0.11001.20033) 32 bits and Windows 10 Home x64

  Mario, 

  The code you posted fails to compile for me in x64 with a mismatch error on this line

  MouseProc = CallNextHookEx(mLngMouseHook, nCode, wParam, ByVal lParam)

  To fix change the return declaration of MouseProc from As Long to As Long for the #If VBA7 version, to match what CallNextHookEx returns.

  With that fix the code works for me in x64 Office. But x64 is extremely sensitive, it can work fine in most systems most of the time but fail in some for no obvious reason. In my apps I have made many changes to minimize such issues. (32x Office in Win64
  is much more stable)

  Your problem —

  mLngMouseHook = SetWindowsHookEx (WH_MOUSE_LL, AddressOf MouseProc, lngAppInst, 0)

  As I say, that works for me and I don’t know why it doesn’t for you. The only thing that stands out is the ‘0’. Normally that should be OK and its Type will coerce to a Long but wouldn’t include it like that. Try changing it to 0& which will explicitly
  change it from an Integer to a Long to match the dwThreadId declaration in the API

  Thank you very, very much Peter, declaring 0& the problem is solved:

      mLngMouseHook = SetWindowsHookEx(WH_MOUSE_LL, AddressOf MouseProc, lngAppInst,
  0&)

  Really Office 64 is extremely sensitive  I have not a compile error, but I have changed your suggestion (Long to LongPtr) and it work

      #If VBA7 Then

          Private Function MouseProc(ByVal nCode As Long, ByVal wParam As LongPtr, ByRef lParam As MOUSEHOOKSTRUCT) As
  LongPtr

• Hi Peter! i’ve been using some code of yours in my excel worksheet for making possible scrolling listbox controls in a Whorksheet (Not Userforms)

  It works fine but sometimes, unexpectedly and without showing any errors, excel chashes and stop working (While scrolling over a Listbox control).

  Here is the code:

  (MODULE CODE)

  Option Explicit

   
  Private Type POINTAPI
    X As Long
    Y As Long
  End Type

   
  Private Type MSLLHOOKSTRUCT
      pt As POINTAPI
      mouseData As Long
      flags As Long
      time 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 Declare Function LBItemFromPt Lib «comctl32.dll» _
  (ByVal hLB As Long, ByVal ptx As Long, ByVal pty As Long, ByVal bAutoScroll As Long) 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 lMouseHook As Long
  Private lListBoxhwnd As Long
  Public bHookSet As Boolean
  Private oListBox As MSForms.ListBox

  Sub HookListBox(ListBox As MSForms.ListBox)

      
      Dim tPt As POINTAPI

      
      Set oListBox = ListBox
      GetCursorPos tPt
      lListBoxhwnd = (WindowFromPoint(tPt.X, tPt.Y))
      PostMessage lListBoxhwnd, WM_LBUTTONDOWN, 0, 0
      If Not bHookSet Then
          lMouseHook = SetWindowsHookEx _
          (WH_MOUSE_LL, _
          AddressOf LowLevelMouseProc, GetAppInstance, 0)
          If lMouseHook <> 0 Then
              bHookSet = True
          End If
      End If

   
  End Sub

  Private Function LowLevelMouseProc _
  (ByVal nCode As Long, ByVal wParam As Long, _
  ByRef lParam As MSLLHOOKSTRUCT) As Long

   
      On Error Resume Next

      
      If (nCode = HC_ACTION) Then
          If WindowFromPoint _
              (lParam.pt.X, lParam.pt.Y) = lListBoxhwnd Then
              If wParam = WM_MOUSEWHEEL Then
                  LowLevelMouseProc = True
                  If lParam.mouseData > 0 Then
                      PostMessage _
                      lListBoxhwnd, WM_KEYDOWN, VK_UP, 0
                      PostMessage _
                      lListBoxhwnd, WM_KEYUP, VK_UP, 0
                  Else
                      PostMessage _
                      lListBoxhwnd, WM_KEYDOWN, VK_DOWN, 0
                      PostMessage _
                      lListBoxhwnd, WM_KEYUP, VK_UP, 0
                  End If
                  Exit Function
              End If
          Else
                  UnhookWindowsHookEx lMouseHook
                  bHookSet = False
          End If
      End If

      
      LowLevelMouseProc = _
      CallNextHookEx _
      (lMouseHook, nCode, wParam, ByVal lParam)

   
  End Function

   
  Private Function GetAppInstance() As Long

   
      GetAppInstance = GetWindowLong _
      (FindWindow(«XLMAIN», Application.Caption), GWL_HINSTANCE)

   
  End Function

  (WHORKSHEET CODE, IN EVERY LISTBOX MOUSE MOVE EVENT)

  Private Sub ListBox2_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)

   Call HookListBox(Sheets(«OPERACIONES»).ListBox2)
  End Sub

  I am Using Office 2007

  I would appreciate any help given

  Thank You!

• Hi Peter! i’ve been using some code of yours in my excel worksheet for making possible scrolling listbox controls in a Whorksheet (Not Userforms)

  It works fine but sometimes, unexpectedly and without showing any errors, excel chashes and stop working (While scrolling over a Listbox control).

  Here is the code:

  (MODULE CODE)

  Option Explicit

   
  Private Type POINTAPI
    X As Long
    Y As Long
  End Type

   
  Private Type MSLLHOOKSTRUCT
      pt As POINTAPI
      mouseData As Long
      flags As Long
      time 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 Declare Function LBItemFromPt Lib «comctl32.dll» _
  (ByVal hLB As Long, ByVal ptx As Long, ByVal pty As Long, ByVal bAutoScroll As Long) 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 lMouseHook As Long
  Private lListBoxhwnd As Long
  Public bHookSet As Boolean
  Private oListBox As MSForms.ListBox

  Sub HookListBox(ListBox As MSForms.ListBox)

      
      Dim tPt As POINTAPI

      
      Set oListBox = ListBox
      GetCursorPos tPt
      lListBoxhwnd = (WindowFromPoint(tPt.X, tPt.Y))
      PostMessage lListBoxhwnd, WM_LBUTTONDOWN, 0, 0
      If Not bHookSet Then
          lMouseHook = SetWindowsHookEx _
          (WH_MOUSE_LL, _
          AddressOf LowLevelMouseProc, GetAppInstance, 0)
          If lMouseHook <> 0 Then
              bHookSet = True
          End If
      End If

   
  End Sub

  Private Function LowLevelMouseProc _
  (ByVal nCode As Long, ByVal wParam As Long, _
  ByRef lParam As MSLLHOOKSTRUCT) As Long

   
      On Error Resume Next

      
      If (nCode = HC_ACTION) Then
          If WindowFromPoint _
              (lParam.pt.X, lParam.pt.Y) = lListBoxhwnd Then
              If wParam = WM_MOUSEWHEEL Then
                  LowLevelMouseProc = True
                  If lParam.mouseData > 0 Then
                      PostMessage _
                      lListBoxhwnd, WM_KEYDOWN, VK_UP, 0
                      PostMessage _
                      lListBoxhwnd, WM_KEYUP, VK_UP, 0
                  Else
                      PostMessage _
                      lListBoxhwnd, WM_KEYDOWN, VK_DOWN, 0
                      PostMessage _
                      lListBoxhwnd, WM_KEYUP, VK_UP, 0
                  End If
                  Exit Function
              End If
          Else
                  UnhookWindowsHookEx lMouseHook
                  bHookSet = False
          End If
      End If

      
      LowLevelMouseProc = _
      CallNextHookEx _
      (lMouseHook, nCode, wParam, ByVal lParam)

   
  End Function

   
  Private Function GetAppInstance() As Long

   
      GetAppInstance = GetWindowLong _
      (FindWindow(«XLMAIN», Application.Caption), GWL_HINSTANCE)

   
  End Function

  (WHORKSHEET CODE, IN EVERY LISTBOX MOUSE MOVE EVENT)

  Private Sub ListBox2_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)

   Call HookListBox(Sheets(«OPERACIONES»).ListBox2)
  End Sub

  I am Using Office 2007

  I would appreciate any help given

  Thank You!

  Actually, the problem is when the mouse cursor leaves the Listbox control.

  While in there (The listbox), the scroll works perfectly.

  But if i move out the mouse cursor and scroll the wheel, it chashes.

  If i click in any other control like a textbox or a random cell in the worksheet, and then scroll, the problem does not occur.

  The event Lost_focus doesn’t handle when i move the cursor out or the Listbox. I suppose that i need an event like «Mouse Leave» or similar to unhook the control….

  Any suggestions?

• Francisco, I don’t see anything obviously wrong with your code, not sure why it fails.  x32 is relatively stable compared to x64. However even in x32 a hook like this can crash Excel without warning if the callback is interrupted, say be stepping through,
  an error, or an issue elsewhere in your code.

  There shouldn’t be any difference with the Listbox on a worksheet, but rather than finding the XLMAIN window get the XLMAIN >  XLDESK > EXCEL7 window for the sheet (a long shot but it might help, but look into the above first).

  In passing you don’t need FindWindow to get the XLMAIN handle, in 2007 simply Application.hwnd. I know you’ve got 2007 but for 2013 and later with SDI start with the workbook.Application.Hwnd

• Hi everyone,

  I work in a windows 10 pro system at 64bit and with Excel 2016 version. I implemented the code of Mario with the corrections that Peter suggest. I have a combobox in a userform and i want to use the scroll wheel for search the date inside a database of 5 years…

  Excel don’t sand me message of error but its don’t work. In particular when I use the scrollwheel in the combobox, is selected the first date of the list with every input (up and down scroll). I have the same problem with the code of the post of peter in 2008…

  Where is my error? I don’t understand

  Thanks in advance.

  The code that i implemented is:

  (in the module)

  Option Explicit

  #If Win64 Then
      Private Type POINTAPI
         XY As LongLong
      End Type
  #Else
      Private Type POINTAPI
             X As Long
             Y As Long
      End Type
  #End If

  Private Type MOUSEHOOKSTRUCT
      Pt As POINTAPI
      hWnd As Long
      wHitTestCode As Long
      dwExtraInfo As Long
  End Type

  #If VBA7 Then
      Private Declare PtrSafe Function FindWindow Lib «user32» _
                                              Alias «FindWindowA» ( _
                                                              ByVal lpClassName As String, _
                                                              ByVal lpWindowName As String) As LongPtr
      #If Win64 Then
          Private Declare PtrSafe Function GetWindowLongPtr Lib «user32» _
                                              Alias «GetWindowLongPtrA» ( _
                                                              ByVal hWnd As LongPtr, _
                                                              ByVal nIndex As Long) As LongPtr
      #Else
          Private Declare PtrSafe Function GetWindowLong Lib «user32» _
                                              Alias «GetWindowLongA» ( _
                                                              ByVal hWnd As LongPtr, _
                                                              ByVal nIndex As Long) As LongPtr
      #End If
      Private Declare PtrSafe Function SetWindowsHookEx Lib «user32» _
                                              Alias «SetWindowsHookExA» ( _
                                                              ByVal idHook As Long, _
                                                              ByVal lpfn As LongPtr, _
                                                              ByVal hmod As LongPtr, _
                                                              ByVal dwThreadId As Long) As LongPtr
      Private Declare PtrSafe Function CallNextHookEx Lib «user32» ( _
                                                              ByVal hHook As LongPtr, _
                                                              ByVal nCode As Long, _
                                                              ByVal wParam As LongPtr, _
                                                             lParam As Any) As LongPtr
      Private Declare PtrSafe Function UnhookWindowsHookEx Lib «user32» ( _
                                                              ByVal hHook As LongPtr) As Long
      ‘Private Declare PtrSafe Function PostMessage Lib «user32.dll» _
      ‘                                         Alias «PostMessageA» ( _
      ‘                                                         ByVal hwnd As LongPtr, _
      ‘                                                         ByVal wMsg As Long, _
      ‘                                                         ByVal wParam As LongPtr, _
      ‘                                                         ByVal lParam As LongPtr) As Long
      #If Win64 Then
          Private Declare PtrSafe Function WindowFromPoint Lib «user32» ( _
                                                              ByVal Point As LongLong) As LongPtr
      #Else
          Private Declare PtrSafe Function WindowFromPoint Lib «user32» ( _
                                                              ByVal xPoint As Long, _
                                                              ByVal yPoint As Long) As LongPtr
      #End If
      Private Declare PtrSafe Function GetCursorPos Lib «user32» ( _
                                                              ByRef lpPoint As POINTAPI) As Long
  #Else
      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 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
  #End If

  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
  Dim n As Long
  Private mCtl As Object
  Private mbHook As Boolean
  #If VBA7 Then
      Private mLngMouseHook As LongPtr
      Private mListBoxHwnd As LongPtr
  #Else
      Private mLngMouseHook As Long
      Private mListBoxHwnd As Long
  #End If

  Sub HookListBoxScroll(frm As Object, ctl As Object)
      Dim tPT As POINTAPI
      #If VBA7 Then
          Dim lngAppInst As LongPtr
          Dim hwndUnderCursor As LongPtr
      #Else
          Dim lngAppInst As Long
          Dim hwndUnderCursor As Long
      #End If
      GetCursorPos tPT
      #If Win64 Then
          hwndUnderCursor = WindowFromPoint(tPT.XY)
      #Else
          hwndUnderCursor = WindowFromPoint(tPT.X, tPT.Y)
      #End If
      If TypeOf ctl Is UserForm Then
          If Not frm Is ctl Then
                 ctl.SetFocus
          End If
      Else
          If Not frm.ActiveControl Is ctl Then
               ctl.SetFocus
          End If
      End If
      If mListBoxHwnd <> hwndUnderCursor Then
          UnhookListBoxScroll
          Set mCtl = ctl
          mListBoxHwnd = hwndUnderCursor
          #If Win64 Then
              lngAppInst = GetWindowLongPtr(mListBoxHwnd, GWL_HINSTANCE)
          #Else
              lngAppInst = GetWindowLong(mListBoxHwnd, GWL_HINSTANCE)
          #End If
          ‘ 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

  #If VBA7 Then
  Private Function MouseProc(ByVal nCode As Long, ByVal wParam As LongPtr, ByRef lParam As MOUSEHOOKSTRUCT) As LongPtr
  #Else
  Private Function MouseProc(ByVal nCode As Long, ByVal wParam As Long, ByRef lParam As MOUSEHOOKSTRUCT) As LongPtr
  #End If
          Dim idx As Long
          On Error GoTo errH
          If (nCode = HC_ACTION) Then
              #If Win64 Then
                  If WindowFromPoint(lParam.Pt.XY) = 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 TypeOf mCtl Is Frame Then
                              If lParam.hWnd > 0 Then idx = -10 Else idx = 10
                              idx = idx + mCtl.ScrollTop
                              If idx >= 0 And idx < ((mCtl.ScrollHeight — mCtl.Height) + 17.25) Then
                                  mCtl.ScrollTop = idx
                              End If
                          ElseIf TypeOf mCtl Is UserForm Then
                              If lParam.hWnd > 0 Then idx = -10 Else idx = 10
                              idx = idx + mCtl.ScrollTop
                              If idx >= 0 And idx < ((mCtl.ScrollHeight — mCtl.Height) + 17.25) Then
                                  mCtl.ScrollTop = idx
                              End If
                          Else
                              If lParam.hWnd > 0 Then idx = -1 Else idx = 1
                              idx = idx + mCtl.ListIndex
                              If idx >= 0 Then mCtl.ListIndex = idx
                          End If
                      Exit Function
                      End If
                  Else
                      UnhookListBoxScroll
                  End If
              #Else
                  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 TypeOf mCtl Is Frame Then
                              If lParam.hWnd > 0 Then idx = -10 Else idx = 10
                              idx = idx + mCtl.ScrollTop
                              If idx >= 0 And idx < ((mCtl.ScrollHeight — mCtl.Height) + 17.25) Then
                                  mCtl.ScrollTop = idx
                              End If
                          ElseIf TypeOf mCtl Is UserForm Then
                              If lParam.hWnd > 0 Then idx = -10 Else idx = 10
                              idx = idx + mCtl.ScrollTop
                              If idx >= 0 And idx < ((mCtl.ScrollHeight — mCtl.Height) + 17.25) Then
                                  mCtl.ScrollTop = idx
                              End If
                          Else
                              If lParam.hWnd > 0 Then idx = -1 Else idx = 1
                              idx = idx + mCtl.ListIndex
                              If idx >= 0 Then mCtl.ListIndex = idx
                          End If
                          Exit Function
                      End If
                  Else
                      UnhookListBoxScroll
                  End If
              #End If
          End If
          MouseProc = CallNextHookEx(mLngMouseHook, nCode, wParam, ByVal lParam)
          Exit Function
  errH:
          UnhookListBoxScroll
  End Function

  (in the Form)

  Private Sub cmbbData_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
  HookListBoxScroll Me, Me.cmbbData
  End Sub
  Private Sub UserForm_Initialize()
  Dim i As Long
  Dim s As String
          s = «this is line «
          For i = 1 To 50
                          Me.cmbbData.AddItem s & i

          Next
  End Sub

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

                                

  • Proposed as answer by
    Buse Cristian
    Thursday, February 14, 2019 1:10 PM
  • Unproposed as answer by
    Buse Cristian
    Thursday, February 14, 2019 1:10 PM

• You could just hook the mouse and get the whole Userform to scroll. By this I mean, listboxes, comboboxes, textboxes, frames, multipages and the form itself. Check out my repository: https://github.com/cristianbuse/VBA-UserForm-MouseScroll that does just that.
  You only need to call 1 line of code to hook it up to any modal form. Enjoy!

• Hi Peter,

  I am using system «64»….

  I got problem with this…. please help me.

  Thank you

  <span style="border:0px; font-weight:inherit; font-style:inherit; font-family:inherit; margin:0px; outline:0px; padding:0px; color:blue">Function</span> CallNextHookEx <span style="border:0px; font-weight:inherit; font-style:inherit; font-family:inherit; margin:0px; outline:0px; padding:0px; color:blue">Lib</span> <span style="border:0px; font-weight:inherit; font-style:inherit; font-family:inherit; margin:0px; outline:0px; padding:0px; color:#a31515">"user32"</span> ( _
                                                          <span style="border:0px; font-weight:inherit; font-style:inherit; font-family:inherit; margin:0px; outline:0px; padding:0px; color:blue">ByVal</span> hHook <span style="border:0px; font-weight:inherit; font-style:inherit; font-family:inherit; margin:0px; outline:0px; padding:0px; color:blue">As</span> <span style="border:0px; font-weight:inherit; font-style:inherit; font-family:inherit; margin:0px; outline:0px; padding:0px; color:blue">Long</span>, _
                                                          <span style="border:0px; font-weight:inherit; font-style:inherit; font-family:inherit; margin:0px; outline:0px; padding:0px; color:blue">ByVal</span> nCode <span style="border:0px; font-weight:inherit; font-style:inherit; font-family:inherit; margin:0px; outline:0px; padding:0px; color:blue">As</span> <span style="border:0px; font-weight:inherit; font-style:inherit; font-family:inherit; margin:0px; outline:0px; padding:0px; color:blue">Long</span>, _
                                                          <span style="border:0px; font-weight:inherit; font-style:inherit; font-family:inherit; margin:0px; outline:0px; padding:0px; color:blue">ByVal</span> wParam <span style="border:0px; font-weight:inherit; font-style:inherit; font-family:inherit; margin:0px; outline:0px; padding:0px; color:blue">As</span> <span style="border:0px; font-weight:inherit; font-style:inherit; font-family:inherit; margin:0px; outline:0px; padding:0px; color:blue">Long</span>, _
                                                          lParam <span style="border:0px; font-weight:inherit; font-style:inherit; font-family:inherit; margin:0px; outline:0px; padding:0px; color:blue">As</span> <span style="border:0px; font-weight:inherit; font-style:inherit; font-family:inherit; margin:0px; outline:0px; padding:0px; color:blue">Any</span>) <span style="border:0px; font-weight:inherit; font-style:inherit; font-family:inherit; margin:0px; outline:0px; padding:0px; color:blue">As</span> <span style="border:0px; font-weight:inherit; font-style:inherit; font-family:inherit; margin:0px; outline:0px; padding:0px; color:blue">Long</span>
  

• Thank you sir, it works perfectly