Excel 2010 UserForm - 窗体不滚动鼠标滚轮 [英] Excel 2010 UserForm - form does not scroll with Mouse Wheel

问题描述

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

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

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

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

以下是我启用滚动的代码：

 如果我。高度> 500然后
 Me.ScrollHeight = Me.height 
 Me.ScrollBars = fmScrollBarsVertical 
 Me.KeepScrollBarsVisible = fmScrollBarsVertical 
 Me.height = 500 
 Me.Width = Me。宽度+ 12 
结束如果
  

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

解决方案

你可以让它只在32位Excel 。该代码将不会在64位Excel下编译和运行。虽然我做的（一点点复杂）版本兼容32位和64位，但它只是不滚动64位，但至少编译（请让我知道，如果有人需要这个64位，所以，你创建一个新的模块并粘贴WinAPI调用的代码：

  Option Explicit 
私有声明函数FindWindow Libuser32别名FindWindowA_ 
（ByVal lpClassName As String，ByVal lpWindowName As String）As Long 
 Private声明函数GetWindowLong Libuser32别名GetWindowLongA_ 
（ByVal hwnd As Long，ByVal nIndex As Long）As Long 
私有声明函数SetWindowLong Libuser32别名SetWindowLongA_ 
 （ByVal hwnd As Long，ByVal nIndex As Long，ByVal dwNewLong As Long）As Long 
 Private Const GWL_STYLE As Long =（-16）'窗口样式的偏移
 Private Const WS_SYSMENU As Long =& ; H80000'风格添加一个系统我nu 
 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 
'可以用Userform 
中的鼠标滚轮滚动私有声明函数CallWindowProc Libuser32.dll别名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 
'处理鼠标事件
 Dim MouseKeys As Long 
 Dim Rotation As Long 
如果Lmsg = WM_MOUSEWHEEL然后
 MouseKeys = wParam和65535 
 Rotation = wParam / 65536 
'我的窗体MouseWheel功能
'=============================== ============================ 
 YOUR_USERFORM_NAME_HERE.MouseWheel旋转
'======= ================================================== ======== 
 End If 
 WindowProc = CallWindowProc（LocalPrevWndProc，Lwnd，Lmsg，wParam，lParam）
结束函数
公共Sub WheelHook（PassedForm As UserForm） 
'在userform 
中获取鼠标事件On Error Resume Next 
设置myForm = PassedForm 
 LocalHwnd = FindWindow（ThunderDFrame，myForm.Caption）
 LocalPrevWndProc = SetWindowLong （LocalHwnd，GWL_WNDPROC，AddressOf WindowProc）
 End Sub 
公共Sub WheelUnHook（）
'释放鼠标事件处理
 Dim WorkFlag As Long 
 On Error Resume Next 
 WorkFlag = SetWindowLong（LocalHwnd，GWL_WNDPROC，LocalPrevWndProc）
设置myForm = Nothing 
 End Sub 
  

然后你添加一个简单的代码到你的userform ...（别忘了替换eframes_（mouseOverFrame_）），您要滚动的UI控件的名称。

 公共Sub MouseWheel（ByVal Rotation As长）
'********************************************* ***** 
'从MouseWheel事件中回复
'相应地向$滚动
'
'由：Mathieu Plante 
'日期：2004年7月
'*************************************************** * 
选择Case frames_（mouseOverFrame _）。ScrollTop  -  Sgn（Rotation）* 18 
 Case Is< 0 
 frames_（mouseOverFrame _）。ScrollTop = 0 
案例是> frame_（mouseOverFrame _）ScrollHeight 
 frames_（mouseOverFrame _）ScrollTop = frames_（mouseOverFrame _）。ScrollHeight 
 Case Else 
 frames_（mouseOverFrame _）。ScrollTop = frames_（mouseOverFrame _）。ScrollTop  -  Sgn ）* 18 
结束选择
 End Sub 
  

因为我想滚动三个不同的框架（取决于当前位于鼠标光标下的框架） - 我做了三个框架的集合，并在每个框架上使用MouseMove事件将框架编号分配给mouseOverFrame_变量。所以当鼠标移动时超过第1帧，滚动器将通过在mouseOverFrame_变量内具有1来知道要滚动哪个框架。

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.

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.

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.

解决方案

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

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

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.

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

这篇关于Excel 2010 UserForm - 窗体不滚动鼠标滚轮的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！