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

相关推荐
菠萝蚊鸭2 小时前
Dhatim FastExcel 读写 Excel 文件
java·excel·fastexcel
一只小灿灿2 小时前
VB.NET在 Excel 二次开发中的全面应用
.net·excel
是小崔啊5 小时前
开源轮子 - EasyExcel01(核心api)
java·开发语言·开源·excel·阿里巴巴
Excel_easy6 小时前
批量识别工作表中二维码信息-Excel易用宝
excel·wps
m0_7482552614 小时前
easyExcel导出大数据量EXCEL文件,前端实现进度条或者遮罩层
前端·excel
小张认为的测试15 小时前
Linux性能监控命令_nmon 安装与使用以及生成分析Excel图表
linux·服务器·测试工具·自动化·php·excel·压力测试
PieroPc21 小时前
Python 写的 智慧记 进销存 辅助 程序 导入导出 excel 可打印
开发语言·python·excel
不吃鱼的羊2 天前
Excel生成DBC脚本源文件
服务器·网络·excel
chenchihwen2 天前
数据分析时的json to excel 转换的好用小工具
数据分析·json·excel