Excel VBA/Listbox прокрутка колесиком мыши
Формулировка задачи:
Добрый день.
Проблема с Listbox , когда перечень элементов превышает границы отображения появляется скролл, беда в том, что он не реагирует на прокрутку колесиком мыши, а клацать мышкой коллегам не удобно.
Как можно настроить, что бы listbox реагировал на колесико мыши?
Спасибо!
P.S.
Во вложении несколько файлов в которых я хотел бы это сделать, необходимо разархивировать и запустить excel файл. Мне не суть важно именно в моем файле это делать, подойдет самый простой вариант от вас.
Проблема с Listbox , когда перечень элементов превышает границы отображения появляется скролл, беда в том, что он не реагирует на прокрутку колесиком мыши, а клацать мышкой коллегам не удобно.
Как можно настроить, что бы listbox реагировал на колесико мыши?
Спасибо!
P.S.
Во вложении несколько файлов в которых я хотел бы это сделать, необходимо разархивировать и запустить excel файл. Мне не суть важно именно в моем файле это делать, подойдет самый простой вариант от вас.
Решение задачи: «Excel VBA/Listbox прокрутка колесиком мыши»
textual
Листинг программы
Private Declare PtrSafe Function FindWindow Lib "USER32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As LongPtr Private Declare PtrSafe Function SetWindowLongPtr Lib "USER32" Alias "SetWindowLongPtrA" (ByVal hWnd As LongPtr, ByVal nIndex As Long, ByVal dwNewLong As LongPtr) As LongPtr 'To be able to scroll with mouse wheel within Userform Private Declare PtrSafe Function CallWindowProc Lib "USER32" Alias "CallWindowProcA" ( _ ByVal lpPrevWndFunc As LongPtr, _ ByVal hWnd As LongPtr, _ ByVal Msg As Long, _ ByVal wParam As LongPtr, _ ByVal lParam As LongPtr) As LongPtr Private Const GWL_WNDPROC = -4 Private Const WM_MOUSEWHEEL = &H20A Dim LocalHwnd As LongPtr Dim LocalPrevWndProc As LongPtr Dim myForm As UserForm Public Function WindowProc(ByVal Lwnd As LongPtr, ByVal Lmsg As Long, ByVal wParam As LongPtr, ByVal lParam As LongPtr) As LongPtr On Error Resume Next '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 UserForm1.MouseWheel Rotation End If WindowProc = CallWindowProc(LocalPrevWndProc, Lwnd, Lmsg, wParam, lParam) End Function Public Sub WheelHook(Caption As String) 'To get mouse events in userform On Error Resume Next 'Set myForm = PassedForm LocalHwnd = FindWindow("ThunderDFrame", Caption) 'MsgBox Err.LastDllError, , "FindWindow" LocalPrevWndProc = SetWindowLongPtr(LocalHwnd, GWL_WNDPROC, AddressOf WindowProc) End Sub Public Sub WheelUnHook() 'To Release Mouse events handling Dim WorkFlag As LongPtr On Error Resume Next WorkFlag = SetWindowLong(LocalHwnd, GWL_WNDPROC, LocalPrevWndProc) Set myForm = Nothing End Sub
ИИ поможет Вам:
- решить любую задачу по программированию
- объяснить код
- расставить комментарии в коде
- и т.д