Excel 2010 UserForm – 窗体不滚动鼠标滚轮

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

单击滚动条时滚动条出现并按预期方式工作，但鼠标滚轮对表单上的滚动条没有影响。

我还没有看到任何启用鼠标滚轮滚动的属性。 我在Google上find的每篇文章都指向滚动UserForm（ListBox，ComboBox等）中的控件，而不是UserForm本身。 我发现的其他文章追溯到Excel 2003，它不支持鼠标滚轮滚动。

有没有人知道这里发生了什么？

这里是我启用滚动的代码：

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 

我在Windows 7 64位笔记本电脑上使用Excel 2010（32位）。 其他计算机上也出现了同样的问题，并且也运行相同的设置。 我没有访问另一个configuration来testing这个。

Answer 1

你可以让它只在32位Excel上工作。 该代码将无法编译和运行在64位Excel下。 虽然我做了一些与32位和64位兼容的（稍微复杂一点的）版本，但它只是不滚动64位，但至less编译（请让我知道，如果有人需要64位，位兼容的代码）。

所以，你创build一个新的模块并粘贴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 

然后你添加一个简单的代码到你的用户表单中（不要忘记用你想要滚动的UI控件的名字来replace“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 

因为我想滚动三个不同的框架（取决于哪个框架当前在鼠标光标下） – 我收集了三个框架，并在每个框架上使用“MouseMove”事件将框架编号分配给“mouseOverFrame_”variables。 因此，当鼠标移动例如第一帧，滚动器将知道哪个帧滚动“1”在“mouseOverFrame_”variables内…