Scroll wheel problems with Userform

Mikeymike_W

Board Regular
Joined
Feb 25, 2016
Messages
165
I am having difficulties getting my scroll wheel to work properly with my multipage userform. There are various threads on this but likely due to my lack of expertise I am unable to work it out from these sources.

I have used the following code, it will scroll down within each page of the userform but it seems to freeze the frame so instead of showing you whats truly at the bottom of the page it justs scrolls showing you a blank form (hope that makes sense).

This is the code I'm using:

Userform code
VBA Code:
[LIST=1]
[*]Private Sub UserForm_Initialize()
[*]HookFormScroll Me
[*]End Sub
[*]Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
[*]UnhookFormScroll
[*]End Sub
[/LIST]

Within a normal module:
VBA Code:
[LIST=1]
[*]
Option Explicit
[*]' Based on code from Peter Thornton here:
[*]' http://social.msdn.microsoft.com/Forums/en-US/7d584120-a929-4e7c-9ec2-9998ac639bea/mouse-scroll-in-userform-listbox-in-excel-2010?forum=isvvba
[*]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 Const cSCROLLCHANGE As Long = 10
[*]Private mLngMouseHook As Long
[*]Private mFormHwnd As Long
[*]Private mbHook As Boolean
[*]Dim mForm As Object
[*]Sub HookFormScroll(oForm As Object)
[*]Dim lngAppInst As Long
[*]Dim hwndUnderCursor As Long
[*]Set mForm = oForm
[*]hwndUnderCursor = FindWindow("ThunderDFrame", oForm.Caption)
[*]Debug.Print "Form window: " & hwndUnderCursor
[*]If mFormHwnd <> hwndUnderCursor Then
[*]UnhookFormScroll
[*]Debug.Print "Unhook old proc"
[*]mFormHwnd = hwndUnderCursor
[*]lngAppInst = GetWindowLong(mFormHwnd, GWL_HINSTANCE)
[*]If Not mbHook Then
[*]mLngMouseHook = SetWindowsHookEx( _
[*]WH_MOUSE_LL, AddressOf MouseProc, lngAppInst, 0)
[*]mbHook = mLngMouseHook <> 0
[*]If mbHook Then Debug.Print "Form hooked"
[*]End If
[*]End If
[*]End Sub
[*]Sub UnhookFormScroll()
[*]If mbHook Then
[*]UnhookWindowsHookEx mLngMouseHook
[*]mLngMouseHook = 0
[*]mFormHwnd = 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
[*]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
[*]MouseProc = CallNextHookEx( _
[*]mLngMouseHook, nCode, wParam, ByVal lParam)
[*]Exit Function
[*]errH:
[*]UnhookFormScroll
[*]End Function
[/LIST]

Thanks in advance for any help you can give
 

Some videos you may like

Excel Facts

Show numbers in thousands?
Use a custom number format of #,##0,K. Each comma after the final 0 will divide the displayed number by another thousand

Watch MrExcel Video

Forum statistics

Threads
1,122,630
Messages
5,597,264
Members
414,133
Latest member
lucid33

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Top