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

相关推荐
Access开发易登软件21 小时前
Access开发一键删除Excel指定工作表
服务器·前端·后端·excel·vba·access·access开发
Saggitarxm1 天前
Golang实现 - 实现只有表头的 Excel 模板,并在指定列添加了下拉框功能。生成的 Excel 文件在打开时,指定列的单元格会显示下拉选项
excel·下拉框选项序列·生成excel模板·下拉框选项
pk_xz1234561 天前
SAP全自动化工具开发:Excel自动上传与邮件通知系统
运维·人工智能·windows·深度学习·分类·自动化·excel
俊昭喜喜里2 天前
Excel——设置打印的区域
excel
开开心心就好2 天前
Excel数据合并工具:零门槛快速整理
运维·服务器·前端·智能手机·pdf·bash·excel
CodeCraft Studio3 天前
Aspose.Cells 应用案例:法国能源企业实现能源数据报告Excel自动化
自动化·excel·能源·aspose·aspose.cells·数据报告
人工智能训练师3 天前
将EXCEL或者CSV转换为键值对形式的Markdown文件
人工智能·excel
hmywillstronger3 天前
【Settlement】P1:整理GH中的矩形GRID角点到EXCEL中
android·excel
吹牛不交税3 天前
.NET使用EPPlus导出EXCEL的接口中,文件流缺少文件名信息
.net·excel
qyykaola4 天前
如何快速比较excel两列,拿出不同的数据
excel