Excel vba listbox 鼠标滚轮滚动

Option Explicit ' 声明Windows API函数 Declare PtrSafe Function SetWindowsHookEx Lib "user32" Alias "SetWindowsHookExA" (ByVal idHook As Long, ByVal lpfn As Long, ByVal hMod As Long, ByVal dwThreadId As Long) As LongPtr Declare PtrSafe Function UnhookWindowsHookEx Lib "user32" (ByVal hhk As LongPtr) As Long Declare PtrSafe Function CallNextHookEx Lib "user32" (ByVal hhk As LongPtr, ByVal nCode As Long, ByVal wParam As Long, ByVal lParam As Long) As Long ' 定义POINTAPI结构体 Type POINTAPI x As Long y As Long End Type ' 定义MSLLHOOKSTRUCT结构体 Type MSLLHOOKSTRUCT pt As POINTAPI mouseData As Long flags As Long time As Long dwExtraInfo As LongPtr End Type ' 定义WH_MOUSE_LL常量 Const WH_MOUSE_LL As Long = 14 ' 钩子过程 Private Declare Function LowLevelMouseProc Lib "user32" (ByVal nCode As Long, ByVal wParam As Long, lParam As MSLLHOOKSTRUCT) As Long Private Sub LowLevelMouseProcWrapper(ByVal nCode As Long, ByVal wParam As Long, lParam As MSLLHOOKSTRUCT) Static hhk As LongPtr Static hookInstalled As Boolean If nCode >= 0 Then Select Case wParam Case WM_MOUSEWHEEL ' 处理鼠标滚动 HandleMouseWheel lparam.mouseData End Select End If ' 调用下一个钩子 CallNextHookEx hhk, nCode, wParam, lParam End Sub ' 处理鼠标滚动 Sub HandleMouseWheel(ByRef mouseData As Long) Dim delta As Long delta = mouseData \ 120 ' 更新ListBox滚动 UpdateListBoxScroll delta End Sub ' 安装钩子 Sub InstallHook() Static hhk As LongPtr Static hookInstalled As Boolean If Not hookInstalled Then hhk = SetWindowsHookEx(WH_MOUSE_LL, AddressOf LowLevelMouseProcWrapper, 0&, 0) If hhk <> 0 Then hookInstalled = True End If End If End Sub ' 卸载钩子 Sub UninstallHook() Static hhk As LongPtr Static hookInstalled As Boolean If hookInstalled Then UnhookWindowsHookEx hhk hookInstalled = False End If End Sub ' 更新ListBox滚动 Sub UpdateListBoxScroll(ByRef delta As Long) Dim ListBox1 As Object Set ListBox1 = ThisWorkbook.Sheets("Sheet1").OLEObjects("ListBox1").Object If ListBox1 Is Nothing Then Exit Sub If delta > 0 Then ' 向上滚动 ListBox1.ListIndex = ListBox1.ListIndex - 1 ElseIf delta < 0 Then ' 向下滚动 ListBox1.ListIndex = ListBox1.ListIndex + 1 End If End Sub