[發問] 如何讓ComboBox可以用滑鼠滾動?

acdx

我的ComboBox裡總共有多達45個選項
如何使用滑鼠滾動來來選擇選單中其他選項?

下載 (40.02 KB)

2013-12-11 16:51

sunnyso

回復 1# acdx

有附件嗎？

acdx

combox.zip (14.22 KB)

下載次數: 10

2013-12-16 10:45

附件如上

c_c_lai

回復 3# acdx
試試看！
combox.rar (17.71 KB)

下載次數: 17

2013-12-16 19:18

c_c_lai

回復 3# acdx
表單->UserForm1

1. Private Sub UserForm_Activate()   
   
2.     ComboBox1.Value = "150"
   
3.     ComboBox1.List = Array("150", "200", "250", "300", "350", "400", "450", "500", "510", "570", "630", _
   
4.         "700", "770", "840", "920", "1000", "1080", "1170", "1270", "1370", "1480", "1600", "1720", "1850", "2000", _
   
5.         "2150", "2320", "2500", "2700", "2900", "3150", "3400", "3700", "4000", "4400", "4800", "5300", "5800", _
   
6.         "6400", "7000", "7700", "8500", "9500", "10500", "12000", "13500")
   
7. End Sub
   
8. 
   
9. Sub ComboBox1_DropButton()
   
10.     'Store the first TopIndex Value
    
11.     intTopIndex = ComboBox1.TopIndex
    
12.     Hook_Mouse
    
13. End Sub
    
14. 
    
15. Private Sub ComboBox1_Exit(ByVal Cancel As MSForms.ReturnBoolean)
    
16.     UnHook_Mouse
    
17. End Sub

複製代碼

c_c_lai

回復 4# c_c_lai
模組->Module1：

1. Option Explicit
   
2. 
   
3. Declare Function FindWindow Lib "user32" Alias "FindWindowA" _
   
4.         (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
   
5. 
   
6. Declare Function GetForegroundWindow Lib "user32" () As Long
   
7. 
   
8. Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" _
   
9.         (ByVal Destination As Long, ByVal Source As Long, ByVal Length As Long)
   
10. 
    
11. Declare Function SetWindowsHookEx Lib _
    
12.         "user32" Alias "SetWindowsHookExA" (ByVal idHook As Long, ByVal lpfn As Long, _
    
13.         ByVal hmod As Long, ByVal dwThreadId As Long) As Long
    
14. 
    
15. Declare Function CallNextHookEx Lib "user32" (ByVal hHook As Long, _
    
16.         ByVal nCode As Long, ByVal wParam As Long, lParam As Any) As Long
    
17. 
    
18. Declare Function UnhookWindowsHookEx Lib "user32" (ByVal hHook As Long) As Long
    
19. 
    
20. Type POINTAPI
    
21.     X As Long
    
22.     Y As Long
    
23. End Type
    
24. 
    
25. Type MSLLHOOKSTRUCT 'Will Hold the lParam struct Data
    
26.     pt As POINTAPI
    
27.     mouseData As Long ' Holds Forward\Bacward flag
    
28.     flags As Long
    
29.     time As Long
    
30.     dwExtraInfo As Long
    
31. End Type
    
32. 
    
33. Const HC_ACTION = 0
    
34. Const WH_MOUSE_LL = 14
    
35. Const WM_MOUSEWHEEL = &H20A
    
36. 
    
37. Dim hhkLowLevelMouse, lngInitialColor As Long
    
38. Dim udtlParamStuct As MSLLHOOKSTRUCT
    
39. Public intTopIndex As Integer
    
40. 
    
41. Private Sub Auto_open()
    
42.     UserForm1.ComboBox1_DropButton
    
43.     UserForm1.Show
    
44. End Sub
    
45. 
    
46. '  ==========================================================================
    
47. '  \\Copy the Data from lParam of the Hook Procedure argument to our Struct
    
48. Function GetHookStruct(ByVal lParam As Long) As MSLLHOOKSTRUCT
    
49.    CopyMemory VarPtr(udtlParamStuct), lParam, LenB(udtlParamStuct)
    
50.    GetHookStruct = udtlParamStuct
    
51. End Function
    
52. 
    
53. '  ===========================================================================
    
54. Function LowLevelMouseProc _
    
55.         (ByVal nCode As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
    
56.     '  Avoid XL crashing if RunTime error occurs due to Mouse fast movement
    
57.     On Error Resume Next
    
58. 
    
59.     If (nCode = HC_ACTION) Then
    
60.         If wParam = WM_MOUSEWHEEL Then
    
61.                 '\\ Don't process Default WM_MOUSEWHEEL Window message
    
62.                 LowLevelMouseProc = True
    
63.                 '  \\ Change this to your userform name
    
64.                 With UserForm1.ComboBox1
    
65.                 '  \\ if rolling forward increase Top index by 1 to cause an Up Scroll
    
66.                 If GetHookStruct(lParam).mouseData > 0 Then
    
67.                     .TopIndex = intTopIndex - 1
    
68.                     '  \\ Store new TopIndex value
    
69.                     intTopIndex = .TopIndex
    
70.                 Else '  \\ if rolling backward decrease Top index by 1 to cause _
    
71.                     '  \\a Down Scroll
    
72.                     .TopIndex = intTopIndex + 1
    
73.                     '  \\ Store new TopIndex value
    
74.                     intTopIndex = .TopIndex
    
75.                 End If
    
76.            End With
    
77.         End If
    
78.         Exit Function
    
79.     End If
    
80. 
    
81.     LowLevelMouseProc = CallNextHookEx(0, nCode, wParam, ByVal lParam)
    
82. End Function
    
83. 
    
84. '  =======================================================================
    
85. Sub Hook_Mouse()
    
86.     hhkLowLevelMouse = SetWindowsHookEx _
    
87.         (WH_MOUSE_LL, AddressOf LowLevelMouseProc, Application.Hinstance, 0)
    
88. End Sub
    
89. 
    
90. '  ========================================================================
    
91. Sub UnHook_Mouse()
    
92.     If hhkLowLevelMouse <> 0 Then UnhookWindowsHookEx hhkLowLevelMouse
    
93. End Sub

複製代碼

c_c_lai

回復 3# acdx
模組裡再加上：

1. Private Sub Auto_Close()
   
2.     UnHook_Mouse
   
3. End Sub

複製代碼

於離開時同時關閉 Hook。

acdx

回復 6# c_c_lai
為何會需要
Private Sub Auto_open()
UserForm1.ComboBox1_DropButton
UserForm1.Show
End Sub
我不需要自動開啟表單 是要把它拿掉嗎?

c_c_lai

回復 8# acdx
那只是要提示你，在使用開啟 UserForm1前要先執行
Hook 的動作而已，同時也為了讓你打開檔案時，便於
觀察到 Mouse Wheel 的運用。

c_c_lai

回復 8# acdx
請參考：
Mouse wheel scroll in a combobox on userform