2

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

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

我还没有看到任何启用鼠标滚轮滚动的属性。我在 Google 上找到的每篇文章都指向用户窗体（ListBox、ComboBox 等）中的滚动控件，而不是用户窗体本身。我发现的其他文章可以追溯到 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 位）。同样的问题也出现在其他计算机上，也运行相同的设置。我无权访问其他配置来测试它。

4

1 回答 1

2

你只能让它在 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

然后你在你的用户窗体中添加一个简单的代码......（不要忘记用你想要滚动的 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

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

于 2013-11-22T12:33:13.607 回答