vba Excel 2010 用户窗体 - 窗体不随鼠标滚轮滚动

Excel 2010 UserForm - form does not scroll with Mouse Wheel

提问by Brian

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.

我有一个使用 VBA 在 Excel 2010 中创建的用户窗体。根据来自特定工作表的数据以编程方式将控件添加到表单中。我的代码添加了所有控件，然后确定表单是否过长。如果是，则表单的最大高度设置为 500 像素并启用滚动。

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.

我还没有看到任何启用鼠标滚轮滚动的属性。我在 Google 上找到的每篇文章都指向用户窗体（列表框、组合框等）内的滚动控件，而不是用户窗体本身。我发现的其他文章可以追溯到 Excel 2003，它不支持开箱即用的鼠标滚轮滚动。

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.

我在 Windows 7 64 位笔记本电脑上使用 Excel 2010（32 位）。同样的问题也出现在其他计算机上，也运行相同的设置。我无权访问其他配置来测试这个。

回答by alexkovelsky

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).

您只能让它在 32 位 Excel 上工作。该代码根本无法在 64 位 Excel 下编译和运行。虽然我制作了（稍微复杂一点）与 32 位和 64 位兼容的版本，但它只是不能在 64 位上滚动，但至少可以编译（请让我知道是否有人需要那个 64-位兼容代码）。

So, you create a new module and paste there code for WinAPI calls:

因此，您创建一个新模块并粘贴 WinAPI 调用的代码：

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.

然后你向你的用户表单添加一个简单的代码......（不要忘记用你想要滚动的 UI 控件的名称替换“frames_(mouseOverFrame_)”）。

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...

因为我想滚动三个不同的帧（取决于当前鼠标光标下的帧） - 我收集了三个帧并在每个帧上使用“MouseMove”事件将帧号分配给“mouseOverFrame_”变量。因此，当鼠标移动到例如第一帧上时，滚动条将通过在“mouseOverFrame_”变量中包含“1”来知道要滚动哪一帧...