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
相关推荐
qq_393828222 小时前
办公文档批量打印器 Word、PPT、Excel、PDF、图片和文本,它都支持批量打印。过期的秋刀鱼!3 小时前
用“做饭”理解数据分析流程(Excel三件套实战)挑战者6668884 小时前
如何将Excel表的内容转化为json格式呢?干净的坏蛋4 小时前
EasyExcel实现Excel复杂格式导出:合并单元格与样式设置实战张太行_10 天前
MySQL与Excel比较cwtlw10 天前
Excel学习03郭优秀的笔记10 天前
计算本地Excel某两列的差异值涔溪10 天前
实现 el-table 中键盘方向键导航功能vue2+vue3(类似 Excel)云博客-资源宝11 天前
Excel函数大全