Scroll Wheel cho ListBox & ComboBox.

[Hoàng Trọng Nghĩa]

Từ nhiều nguồn code sưu tầm được cả trên diễn đàn ta lẫn các diễn đàn khác, thì mỗi một thủ tục sẽ cho ra một kết quả nhất định, song, chúng không lỗi vấn đề này thì lỗi ở vấn đề khác.

Chẳng hạn, có code thì cuộn trên ListBox nhưng khi mở một ứng dụng khác như NotePad thì vô hiệu hóa thanh cuộn của NotePad, nhưng ListBox vẫn hoạt động.

Chẳng hạn, một thủ tục không bị lỗi trên, nhưng nếu vô tình code bất kỳ nào đó trên form bị lỗi, thì cả Excel sẽ bị treo mà không thể nào Break được, buộc phải Alt+Ctrl+Delete để giải phóng Excel.

Chẳng hạn, một thủ tục cuộn các Item trong ListBox, đồng thời lại Select các Item này. Đây là một điều tối kỵ khi ListBox có sử dụng các sự kiện Change hoặc Click, mỗi lần cuộn, mỗi lần tạo ra sự kiện thì hoàn toàn chẳng tốt lành gì mà cứ hao tốn bộ nhớ cho việc tính toán khi chạy sự kiện Change/ Click.

Từ đó, tôi kết hợp, nghiên cứu các thủ tục lại với nhau, chỉnh sửa, cải tiến, xử lý để có một file mà tôi cho là tránh được tất cả 3 trường hợp trên như sau:

Tạo một file Excel có chứa một UserForm1, 1 ComboBox1 & 1 ListBox1 trong Form đó.

Code chính trong Module:

[GPECODE=vb]
Option Explicit
'************************************************************************************
Private Type PointAPI
X As Long
Y As Long
End Type
Private Type MOUSEHOOKSTRUCT
pt As PointAPI
hwnd As Long
wHitTestCode As Long
dwExtraInfo As Long
End Type
'************************************************************************************
Private Declare Function FindWindow Lib "user32" _
Alias "FindWindowA" ( _
ByVal lpClassName As String, _
ByVal lpWindowName As String) As Long
Private Declare Function GetWindowLong Lib "user32.dll" _
Alias "GetWindowLongA" ( _
ByVal hwnd As Long, _
ByVal nIndex As Long) As Long
Private Declare Function SetWindowsHookEx Lib "user32" _
Alias "SetWindowsHookExA" ( _
ByVal idHook As Long, _
ByVal lpfn As Long, _
ByVal hmod As Long, _
ByVal dwThreadId As Long) As Long
Private Declare Function CallNextHookEx Lib "user32" ( _
ByVal hHook As Long, _
ByVal nCode As Long, _
ByVal wParam As Long, _
ByRef lParam As Any) As Long
Private Declare Function UnhookWindowsHookEx Lib "user32" ( _
ByVal hHook As Long) As Long
Private Declare Function WindowFromPoint Lib "user32" ( _
ByVal xPoint As Long, _
ByVal yPoint As Long) As Long
Private Declare Function GetCursorPos Lib "user32.dll" ( _
ByRef lpPoint As PointAPI) As Long
'************************************************************************************
Private Const WH_MOUSE_LL As Long = 14
Private Const WM_MOUSEWHEEL As Long = &H20A
Private Const HC_ACTION As Long = 0
Private Const GWL_HINSTANCE As Long = (-6)
'************************************************************************************
Private mLngMouseHook As Long
Private mControlHwnd As Long
Private mbHook As Boolean
Private mCtl As MSForms.Control
'************************************************************************************


Sub HookControlScroll(ByVal ctl As MSForms.Control)
Dim lngAppInst As Long
Dim hwndUnderCursor As Long
Dim tPT As PointAPI
GetCursorPos tPT
hwndUnderCursor = WindowFromPoint(tPT.X, tPT.Y)
If mControlHwnd <> hwndUnderCursor Then
UnhookControlScroll
Set mCtl = ctl
mControlHwnd = hwndUnderCursor
lngAppInst = GetWindowLong(mControlHwnd, GWL_HINSTANCE)
If Not mbHook Then
mLngMouseHook = _
SetWindowsHookEx(WH_MOUSE_LL, _
AddressOf MouseProc, _
lngAppInst, 0)
mbHook = mLngMouseHook <> 0
End If
End If
End Sub
'************************************************************************************


Sub UnhookControlScroll()
If mbHook Then
Set mCtl = Nothing
UnhookWindowsHookEx mLngMouseHook
mLngMouseHook = 0
mControlHwnd = 0
mbHook = False
End If
End Sub
'************************************************************************************


Private Function MouseProc( _
ByVal nCode As Long, _
ByVal wParam As Long, _
ByRef lParam As MOUSEHOOKSTRUCT) As Long

On Error GoTo ErrorHandler

Dim Index As Long
If (nCode = HC_ACTION) Then
If WindowFromPoint(lParam.pt.X, lParam.pt.Y) = mControlHwnd Then
If wParam = WM_MOUSEWHEEL Then

MouseProc = True

If lParam.hwnd > 0 Then
Index = -1
Else
Index = 1
End If

Index = Index + mCtl.TopIndex

If Index >= 0 Then
mCtl.TopIndex = Index
End If

Exit Function
End If
Else
UnhookControlScroll
End If
End If
MouseProc = CallNextHookEx( _
mLngMouseHook, nCode, wParam, ByVal lParam)
Exit Function
ErrorHandler:
UnhookControlScroll
End Function
[/GPECODE]

Và thủ tục trong UserForm:

[GPECODE=vb]
Option Explicit


'************************************************************************************
Private Sub UserForm_Initialize()
Dim b As Byte
Dim s As String
s = "Trong Nghia "
For b = 1 To 50
ComboBox1.AddItem s & b
ListBox1.AddItem s & b
Next
End Sub


Private Sub UserForm_Terminate()
UnhookControlScroll
End Sub
'************************************************************************************


Private Sub ComboBox1_MouseMove(ByVal Button As Integer, _
ByVal Shift As Integer, _
ByVal X As Single, _
ByVal Y As Single)
HookControlScroll ComboBox1
End Sub


Private Sub ListBox1_MouseMove(ByVal Button As Integer, _
ByVal Shift As Integer, _
ByVal X As Single, _
ByVal Y As Single)
HookControlScroll ListBox1
End Sub
[/GPECODE]

Lưu ý, tôi có thêm 1 nút lệnh trên form nhằm kiểm tra nếu lỗi thì Excel có bị treo hay không. Code của nút lệnh này:

Private Sub CommandButton1_Click()
    ''Thu loi de xem co bi treo Excel
    ''hay khong, cac phien ban truoc
    ''thuong bi treo khi gap loi.
[COLOR=#ff0000][B]    MsgBox 4 / 0[/B][/COLOR]
End Sub

Các bạn tải về trải nghiệm và test thử nếu có lỗi gì thì cho mình biết nhé!

Hoàng Trọng Nghĩa

''=====================================

Đã update phiên bản 2, chạy luôn trên ComboBox trên sheet (LbxAndCbxScroll.V2.xls).

Thử với phiên bản 64bit, ai có máy loại này test thử xem có lỗi gì không (mình không có nên không test được). Thanks.

 

[Let'GâuGâu]

mouse của laptop không chạy được anh Nghĩa nhỉ?, anh viết thêm cho nó hoạt động được thì rất tuyệt

cám ơn

 

[Hoàng Trọng Nghĩa]

mouse của laptop không chạy được anh Nghĩa nhỉ?, anh viết thêm cho nó hoạt động được thì rất tuyệt

cám ơn

Thực sự mà nói, thì ban đầu code của thầy siwtom laptop của tôi dùng được trên touchpad, nhưng sau đó, cũng chẳng hiểu sao, chính code đó lại không xài được trên máy tôi. Để tôi cố gắng nghiên cứu hay học hỏi thêm từ các diễn đàn khác ra sao.

 

[fclinux]

Thực sự mà nói, thì ban đầu code của thầy siwtom laptop của tôi dùng được trên touchpad, nhưng sau đó, cũng chẳng hiểu sao, chính code đó lại không xài được trên máy tôi. Để tôi cố gắng nghiên cứu hay học hỏi thêm từ các diễn đàn khác ra sao.

Hi a Nghĩa, cái này có code cho dòng 64 bit ko, code này chắc chỉ chạy trên 32bit a à

 

[daihao]

tôi add combobox trong sheet khong add combobox trong form thì thay đổi như thế nào?

 

[Let'GâuGâu]

tôi add combobox trong sheet khong add combobox trong form thì thay đổi như thế nào?

khi tôi mới tập tễnh lên diễn đàn này, có sưu tầm được một đạon code, bạn xem thử có xài được ko
http://www.giaiphapexcel.com/forum/...lidation-combo-box-có-thể-sử-dụng-mouse-wheel

 

[Hoàng Trọng Nghĩa]

tôi add combobox trong sheet khong add combobox trong form thì thay đổi như thế nào?

Hi a Nghĩa, cái này có code cho dòng 64 bit ko, code này chắc chỉ chạy trên 32bit a à

Đã update phiên bản 2, chạy luôn trên ComboBox trên sheet (LbxAndCbxScroll.V2.xls).

Thử với phiên bản 64bit, ai có máy loại này test thử xem có lỗi gì không (mình không có nên không test được). Thanks.

Tải file tại bài #1 của topic này!

 

[doveandrose]

Đã update phiên bản 2, chạy luôn trên ComboBox trên sheet (LbxAndCbxScroll.V2.xls).

Thử với phiên bản 64bit, ai có máy loại này test thử xem có lỗi gì không (mình không có nên không test được). Thanks.

Tải file tại bài #1 của topic này!

có máy 64 bit nhưng chuột giữa bị liệt sao thử được ta ?
Nhưng thấy có cái chỗ phải sửa

Private Declare PtrSafe Function SetWindowsHookEx Lib "user32" _
            Alias "SetWindowsHookExA" ( _
            ByVal idHook As Long, _
            ByVal lpfn As [COLOR=#ff0000][SIZE=3][B]LongPtr[/B][/SIZE][/COLOR], _
            ByVal hmod As Long, _
            ByVal dwThreadId As Long) As Long

đợi đi kiếm chuột khác tính tiếp

 

[Hoàng Trọng Nghĩa]

có máy 64 bit nhưng chuột giữa bị liệt sao thử được ta ?
Nhưng thấy có cái chỗ phải sửa

Private Declare PtrSafe Function SetWindowsHookEx Lib "user32" _
            Alias "SetWindowsHookExA" ( _
            ByVal idHook As Long, _
            ByVal lpfn As [COLOR=#ff0000][SIZE=3][B]LongPtr[/B][/SIZE][/COLOR], _
            ByVal hmod As Long, _
            ByVal dwThreadId As Long) As Long

đợi đi kiếm chuột khác tính tiếp

OK, thank you! Sai ở đâu sửa ngay ở đó!

 

[daihao]

Tôi có file có chứa 6 combobox, tôi xin nhờ các thầy chỉ giao cho:
- lam the nao de tu: danh sach 1, danh sach 2 vẫn giữ được color khi đưa vào combobox.
- 6 combobox này không được chọn dữ liệu trong danh sách trùng nhau.f

 

[Hoàng Trọng Nghĩa]

Tôi có file có chứa 6 combobox, tôi xin nhờ các thầy chỉ giao cho:
- lam the nao de tu: danh sach 1, danh sach 2 vẫn giữ được color khi đưa vào combobox.
- 6 combobox này không được chọn dữ liệu trong danh sách trùng nhau.f

Lẽ ra bạn phải mở 1 topic khác và hỏi về vấn đề này.

1) Bạn nói giữ được Color là giữ màu nền hay màu chữ? Riêng màu chữ hay màu nền của ComboBox không thể xen kẻ màu này màu kia nhé, nó chỉ được set 1 màu cho toàn bộ chữ hoặc nền thôi.

2) Tối nghĩa quá, hay do tôi kém thông minh nên không hiểu câu này. Tôi chẳng biết danh sách nào và không trùng nhau như thế nào. Bạn phải nói rõ cụ thể là gì, đưa ra ví dụ hay gì đó mà cho người đọc hiểu.

 

[daihao]

Danh sách trùng nhau, nghĩa là: combo box này chọn cái gì thì combo box khác ko được chọn cái đó.

 

[Hoàng Trọng Nghĩa]

Danh sách trùng nhau, nghĩa là: combo box này chọn cái gì thì combo box khác ko được chọn cái đó.

Tại sao File của bạn lại phân ra 2 danh sách? Sao không làm cho mỗi ComboBox là một danh sách? Giả dụ như ComboBox1, 2, 3 là danh sách 1, ComboBox4, 5, 6 là danh sách 2?

Và có phải bạn muốn ComboBox nào đã chọn được tên này thì ComboBox khác không chọn lại tên đó đúng không?

 

[daihao]

Đúng ý tôi: ComboBox nào đã chọn được tên này thì ComboBox khác không chọn lại tên đó"

 

[daihao]

Tiện đây tôi hỏi thêm thầy về việc Sort danh sách trong ComboBox, tôi có một danh sách thường xuyên thay đổi tên sản phẩm, tôi muốn danh sách này tự động Sort khi đưa vào ComboBox, tôi đã tìm trong diễn đàn bằng cách dùng hàm Index nhưng rất nặng máy. Cách làm hiện nay của tôi là copy danh sách ra một nơi khác và Sort bằng tay rồi mới đưa vào ComboBox, do đó mỗi lần thêm hoặc xóa sản phẩm đều phải Sort bằng tay lại. Có hàm Macro nào để xử lý việc này không? Tôi xin cảm ơn.

 

[NguyenNgocSon]

Ứng dụng dùng tương đối ốn. Nhưng đôi lúc sử dụng lại tự thoát Excel
Không biết có cách nào khắc phục vấn đề này ?

 

[quyenpv]

Đã update phiên bản 2, chạy luôn trên ComboBox trên sheet (LbxAndCbxScroll.V2.xls).

Thử với phiên bản 64bit, ai có máy loại này test thử xem có lỗi gì không (mình không có nên không test được). Thanks.

Tải file tại bài #1 của topic này!

Thử phát treo và khởi động lai excel luôn anh Nghĩa

 

[Hoàng Trọng Nghĩa]

Quái lạ, Với Excel 2010 32bit, chạy trên Win64bit thì OK, còn Excel 2016 64bit, chạy trên Win64bit thì Combobox trên Form nó đơ ra, Listbox thì cuộn chuột được!
Các bạn kiểm tra giúp tôi xem lỗi tại đâu nhé. Cám ơn.

 

[Nguyễn Duy Tuân]

Phiên bản "LbxAndCbxScroll.V3" ở trên lỗi với Office 64-bit, Windows 64-bit. Tôi đã sửa để chạy cho cả hai môi trường này rồi nhé. Đã test Office 2016, Office365 64-bit, 32-bit, Windows 10 64-bit
(*) Download:

http://bluesofts.net/Products/daotao/vba/nangcao/baitap/LbxAndCbxScroll.V4_fixed%20by_Tuan.zip

 

[Hoàng Trọng Nghĩa]

Phiên bản "LbxAndCbxScroll.V3" ở trên lỗi với Office 64-bit, Windows 64-bit. Tôi đã sửa để chạy cho cả hai môi trường này rồi nhé. Đã test Office 2016, Office365 64-bit, 32-bit, Windows 10 64-bit
(*) Download:

http://bluesofts.net/Products/daotao/vba/nangcao/baitap/LbxAndCbxScroll.V4_fixed%20by_Tuan.zip

Đã test, chạy rất mượt mà, không bị lỗi treo! Cám ơn Anh rất nhiều!