I have a UserForm I've created in Excel 2010 using VBA. Controls are added to the form programmatically based on data from a particular sheet. My code adds all the controls and then determines if the form is excessively long. If it is, then the form gets set to a maximum height of 500px and scrolling is enabled.
The scrollbars appear and work as expected when clicking on the scrollbars, but the mouse scrollwheel has no effect on the scrollbars on the form.
I haven't seen any properties for enabling mouse wheel scrolling. Every article I've found on Google points to scrolling controls within a UserForm (ListBox, ComboBox, etc.) and not the UserForm itself. Other articles I've found are dated back to Excel 2003 which did not support mouse wheel scrolling out of the box.
Does anyone have any idea what's going on here?
Here is the code where I enable scrolling:
If Me.height > 500 Then
Me.ScrollHeight = Me.height
Me.ScrollBars = fmScrollBarsVertical
Me.KeepScrollBarsVisible = fmScrollBarsVertical
Me.height = 500
Me.Width = Me.Width + 12
End If
I am using Excel 2010 (32bit) on a Windows 7 64bit laptop. The same issue has appeared on other computers as well also running the same setup. I don't have access to another configuration to test this.
You can get it to work only on 32-bit Excel. The code won't compile and run at all under 64-bit Excel. Though I made (little bit more complicated) version that is compatible with both 32-bit and 64-bit, but it just don't scrolls on 64-bit, but at least compiles (please let me know if somebody needs that 64-bit compatible code).
So, you create a new module and paste there code for WinAPI calls:
Option Explicit
Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" _
(ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Private Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" _
(ByVal hwnd As Long, ByVal nIndex As Long) As Long
Private Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" _
(ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Private Const GWL_STYLE As Long = (-16) 'The offset of a window's style
Private Const WS_SYSMENU As Long = &H80000 'Style to add a system menu
Private Const WS_MINIMIZEBOX As Long = &H20000 'Style to add a Minimize box on the title bar
Private Const WS_MAXIMIZEBOX As Long = &H10000 'Style to add a Maximize box to the title bar
'To be able to scroll with mouse wheel within Userform
Private Declare Function CallWindowProc Lib "user32.dll" Alias "CallWindowProcA" ( _
ByVal lpPrevWndFunc As Long, ByVal hwnd As Long, ByVal Msg As Long, ByVal wParam As Long, _
ByVal lParam As Long) As Long
Private Const GWL_WNDPROC = -4
Private Const WM_MOUSEWHEEL = &H20A
Dim LocalHwnd As Long
Dim LocalPrevWndProc As Long
Dim myForm As UserForm
Private Function WindowProc(ByVal Lwnd As Long, ByVal Lmsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
'To handle mouse events
Dim MouseKeys As Long
Dim Rotation As Long
If Lmsg = WM_MOUSEWHEEL Then
MouseKeys = wParam And 65535
Rotation = wParam / 65536
'My Form s MouseWheel function
'=================================================================
YOUR_USERFORM_NAME_HERE.MouseWheel Rotation
'=================================================================
End If
WindowProc = CallWindowProc(LocalPrevWndProc, Lwnd, Lmsg, wParam, lParam)
End Function
Public Sub WheelHook(PassedForm As UserForm)
'To get mouse events in userform
On Error Resume Next
Set myForm = PassedForm
LocalHwnd = FindWindow("ThunderDFrame", myForm.Caption)
LocalPrevWndProc = SetWindowLong(LocalHwnd, GWL_WNDPROC, AddressOf WindowProc)
End Sub
Public Sub WheelUnHook()
'To Release Mouse events handling
Dim WorkFlag As Long
On Error Resume Next
WorkFlag = SetWindowLong(LocalHwnd, GWL_WNDPROC, LocalPrevWndProc)
Set myForm = Nothing
End Sub
And then you add a simple code to your userform... (don't forget to replace "frames_(mouseOverFrame_)") with name of your UI control you want to scroll.
Public Sub MouseWheel(ByVal Rotation As Long)
'************************************************
' To respond from MouseWheel event
' Scroll accordingly to direction
'
' Made by: Mathieu Plante
' Date: July 2004
'************************************************
Select Case frames_(mouseOverFrame_).ScrollTop - Sgn(Rotation) * 18
Case Is < 0
frames_(mouseOverFrame_).ScrollTop = 0
Case Is > frames_(mouseOverFrame_).ScrollHeight
frames_(mouseOverFrame_).ScrollTop = frames_(mouseOverFrame_).ScrollHeight
Case Else
frames_(mouseOverFrame_).ScrollTop = frames_(mouseOverFrame_).ScrollTop - Sgn(Rotation) * 18
End Select
End Sub
Because I wanted to scroll three different frames (depending on which frame is currently under mouse cursor) - I made a collection of three frames and used "MouseMove" event on each frame to assign frame number to "mouseOverFrame_" variable. So when mouse moved e.g. over 1st frame, the scroller will know which frame to scroll by having "1" inside "mouseOverFrame_" variable...