Excel 2010 UserForm - 窗體不滾動鼠標滾輪

Question

我有一個用戶窗體我已經在Excel 2010中使用VBA創建。基於來自特定工作表的數據，控件將以編程方式添加到表單中。我的代碼添加了所有控件，然後確定窗體是否過長。如果是，則表單將被設置爲500px的最大高度，並啓用滾動。

滾動條在單擊滾動條時出現並按預期工作，但鼠標滾輪對窗體上的滾動條沒有影響。

我還沒有看到任何啓用鼠標滾輪滾動的屬性。我在Google上找到的每篇文章都指向滾動UserForm（ListBox，ComboBox等）中的控件，而不是UserForm本身。我發現的其他文章追溯到Excel 2003，它不支持鼠標滾輪滾動。

有沒有人有任何想法這裏發生了什麼？

這裏就是我啓用滾動代碼：在64位Windows 7的筆記本電腦

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 

我使用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 

然後添加一個簡單的代碼到您的用戶窗體......（不要忘記，以取代「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 

因爲想滾動三個不同的幀（取決於哪個幀目前正在鼠標光標） - I製成三幀和用「的MouseMove」事件的集合的每個幀上分配幀號爲「 mouseOverFrame_「變量。所以當鼠標移動時在第一幀中，滾動器將通過在「mouseOverFrame_」變量中具有「1」來知道要滾動哪個幀...