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

相关推荐
小c君tt1 小时前
MFC中Excel的导入以及使用步骤
c++·excel·mfc
一名技术极客3 小时前
Vue2 doc、excel、pdf、ppt、txt、图片以及视频等在线预览
pdf·powerpoint·excel·文件在线预览
用余生去守护3 小时前
【反射率】-- Lab 转换(excel)
excel
进击的六角龙3 小时前
Python中处理Excel的基本概念(如工作簿、工作表等)
开发语言·python·excel
TracyDemo3 小时前
excel功能
excel
lc寒曦3 小时前
【VBA实战】用Excel制作排序算法动画
排序算法·excel·vba
zzzgd8163 小时前
easyexcel实现自定义的策略类, 最后追加错误提示列, 自适应列宽,自动合并重复单元格, 美化表头
java·excel·表格·easyexcel·导入导出
努力学习技能的LY3 小时前
Excel:vba实现批量插入图片批注
excel
图片转成excel表格5 小时前
wps怎么算出一行1和0两种数值中连续数值1的个数,出现0后不再计算?
excel·wps
q2498596936 小时前
前端预览word、excel、ppt
前端·word·excel