要实现鼠标滚轮控制单元格数值的增加和减少，我们需要对现有代码进行修改，使其能够区分鼠标滚轮的前后滚动，并相应地调整单元格中的数值。以下是经过修改的代码，确保它能够实现你所期望的功能：
Public hHook As LongPtr <h1>If VBA7 Then</h1><pre class="brush:php;toolbar:false;">Public Declare PtrSafe Function SetWindowsHookEx Lib "user32" Alias "SetWindowsHookExA" (ByVal idHook As Long, ByVal lpfn As LongPtr, ByVal hmod As LongPtr, ByVal dwThreadId As Long) As LongPtr Public Declare PtrSafe Function UnhookWindowsHookEx Lib "user32" (ByVal hhk As LongPtr) As Long Public Declare PtrSafe Function CallNextHookEx Lib "user32" (ByVal hHook As LongPtr, ByVal ncode As Long, ByVal wParam As LongPtr, lParam As Any) As LongPtr Public Declare PtrSafe Function GetCurrentThreadId Lib "kernel32" () As Long
End If
Public Const WH_MOUSE = 7 Public Const WM_MOUSEWHEEL = &H20A
Sub BeginHK() '获取当前的线程ID i = GetCurrentThreadId '这里安装的是鼠标钩子 hHook = SetWindowsHookEx(WH_MOUSE, AddressOf HookProc, 0, i) End Sub
'Hook程序 Public Function HookProc(ByVal code As Long, ByVal wParam As LongPtr, ByVal lParam As LongPtr) As LongPtr Dim wks As Worksheet Set wks = Excel.ActiveSheet
'如果code参数＜0，则一定要返回CallNextHookEx函数的返回值
If code < 0 Then
HookProc = CallNextHookEx(hHook, code, wParam, lParam)
Exit Function
End If
'检查是否是鼠标滚轮事件
If code = HC_ACTION And wParam = WM_MOUSEWHEEL Then
Dim zDelta As Integer
zDelta = (wParam And &HFFFF0000) \ &H10000
Dim activeCell As Range
Set activeCell = wks.Application.ActiveCell
'检查活动单元格是否包含数字
If IsNumeric(activeCell.Value) Then
If zDelta > 0 Then
'鼠标滚轮向前滚动，增加0.01
activeCell.Value = activeCell.Value + 0.01
ElseIf zDelta < 0 Then
'鼠标滚轮向后滚动，减少0.01
activeCell.Value = activeCell.Value - 0.01
End If
End If
End If
'继续传递消息给其他钩子
HookProc = CallNextHookEx(hHook, code, wParam, lParam)End Function
Sub EndHK() '卸载钩子 UnhookWindowsHookEx hHook End Sub
这段代码的主要修改点如下：
-
捕获鼠标滚轮事件：我们使用
WM_MOUSEWHEEL
常量来识别鼠标滚轮事件。 -
获取滚轮方向：通过
zDelta
变量来判断滚轮的滚动方向。zDelta
的值大于零表示滚轮向前滚动，小于零表示滚轮向后滚动。 -
调整单元格值：根据
zDelta
的值，相应地增加或减少单元格中的数值。
使用这个修改后的代码，你应该能够实现鼠标滚轮向前滚动时单元格中的数值增加0.01，向后滚动时减少0.01的功能。
图1
请注意，使用这段代码时，需要在Excel中运行
BeginHK子程序来启动钩子，并在完成操作后运行
EndHK子程序来卸载钩子。如果有任何问题或需要进一步的调整，请随时告知。
