幸いソリューションは既にありました。ありがとうございます。
参照: https://social.msdn.microsoft.com/Forums/en-US/7d584120-a929-4e7c-9ec2-9998ac639bea/mouse-scroll-in-userform-listbox-in-excel-2010?forum=isvvba
Private Sub ListBox1_MouseMove( _ ByVal Button As Integer, ByVal Shift As Integer, _ ByVal x As Single, ByVal y As Single) ' start tthe hook HookListBoxScroll End Sub Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer) UnhookListBoxScroll End Sub ''''''' end Userform code ''''''' normal module code 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, _ lParam As Any) As Long Private Declare Function UnhookWindowsHookEx Lib "user32" ( _ ByVal hHook As Long) As Long Private Declare Function PostMessage Lib "user32.dll" _ Alias "PostMessageA" ( _ ByVal hwnd As Long, _ ByVal wMsg As Long, _ ByVal wParam As Long, _ ByVal lParam 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 Const WM_KEYDOWN As Long = &H100 Private Const WM_KEYUP As Long = &H101 Private Const VK_UP As Long = &H26 Private Const VK_DOWN As Long = &H28 Private Const WM_LBUTTONDOWN As Long = &H201 Private mLngMouseHook As Long Private mListBoxHwnd As Long Private mbHook As Boolean Sub HookListBoxScroll() Dim lngAppInst As Long Dim hwndUnderCursor As Long Dim tPT As POINTAPI GetCursorPos tPT hwndUnderCursor = WindowFromPoint(tPT.x, tPT.y) If mListBoxHwnd <> hwndUnderCursor Then UnhookListBoxScroll mListBoxHwnd = hwndUnderCursor lngAppInst = GetWindowLong(mListBoxHwnd, GWL_HINSTANCE) PostMessage mListBoxHwnd, WM_LBUTTONDOWN, 0&, 0& If Not mbHook Then mLngMouseHook = SetWindowsHookEx( _ WH_MOUSE_LL, AddressOf MouseProc, lngAppInst, 0) mbHook = mLngMouseHook <> 0 End If End If End Sub Sub UnhookListBoxScroll() If mbHook Then UnhookWindowsHookEx mLngMouseHook mLngMouseHook = 0 mListBoxHwnd = 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 errH 'Resume Next If (nCode = HC_ACTION) Then If WindowFromPoint(lParam.pt.x, lParam.pt.y) = mListBoxHwnd Then If wParam = WM_MOUSEWHEEL Then MouseProc = True If lParam.hwnd > 0 Then PostMessage mListBoxHwnd, WM_KEYDOWN, VK_UP, 0 Else PostMessage mListBoxHwnd, WM_KEYDOWN, VK_DOWN, 0 End If PostMessage mListBoxHwnd, WM_KEYUP, VK_UP, 0 Exit Function End If Else UnhookListBoxScroll End If End If MouseProc = CallNextHookEx( _ mLngMouseHook, nCode, wParam, ByVal lParam) Exit Function errH: UnhookListBoxScroll End Function
0 件のコメント:
コメントを投稿