Question

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

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

我没有看到任何启用鼠标滚轮滚动的属性。我在Google上找到的每篇文章都指向在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位）。其他计算机上也出现了同样的问题，并且运行相同的设置。我无法访问其他配置来测试它。

Answer 1

您可以让它仅适用于32位Excel。代码不会在64位Excel下编译和运行。虽然我制作了（稍微复杂一点）与32位和64位兼容的版本，但它只是不在64位上滚动，但至少编译（请告诉我，如果有人需要64-位兼容代码）。

因此，您创建一个新模块并粘贴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

然后你向你的userform添加一个简单的代码...（不要忘记将“frames_（mouseOverFrame_）”替换为你要滚动的UI控件的名称。

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_”变量。因此当鼠标移动时，超过第1帧，滚动条将通过“mouseOverFrame_”变量中的“1”来知道要滚动的帧...

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

1 个答案: