如何在Excel中捕获左键单击?

lokaqttq  于 2023-02-10  发布在  其他
关注(0)|答案(2)|浏览(187)

我想知道单元格的选择是由光标移动还是鼠标操作引起的。
有很多文章解释了如何在Excel中诱捕鼠标点击,甚至有一些解释了左键点击可以被诱捕。
在Web上可以多次找到此代码:

' The declaration tells VBA where to find and how to call the API
Private Declare Function GetAsyncKeyState Lib "user32" (ByVal vKey As Long) As Integer
' The function returns whether a key (or mouse button) is pressed or not
Public Function KeyPressed(ByVal Key As Long) As Boolean
    KeyPressed = CBool((GetAsyncKeyState(Key) And &H8000) = &H8000)
End Function

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    
    If (KeyPressed(&H1) = True) Then
        MsgBox "Left click"
    End If

    If (KeyPressed(&H2) = True) Then
        MsgBox "Right click"
    End If
        
End Sub

这段代码捕获了右键单击事件,但没有捕获左键!可能是因为它被放置在Worksheet_SelectionChange事件中,而该事件只有在SelectionChanged发生时才被调用,因此当左键已经被释放时才被调用!
如何检测工作表单元格上的左键单击,以了解单元格的选择是由键盘输入(箭头或回车)还是由鼠标左/右键单击操作引起的?

okxuctiv

okxuctiv1#

我发现了这篇伟大的文章,并适应它的鼠标按钮检查:https://www.mrexcel.com/board/threads/keypress-event-for-worksheet-cells.181654/
添加此模块:

Option Explicit

Declare Function SetWindowsHookEx Lib "user32" Alias "SetWindowsHookExA" _
                                  (ByVal idHook As Long, ByVal lpfn As Long, ByVal hmod As Long, ByVal dwThreadId As Long) As Long

Declare Function CallNextHookEx Lib "user32" _
                                (ByVal hHook As Long, ByVal nCode As Long, ByVal wParam As Long, lParam As Any) As Long

Declare Function UnhookWindowsHookEx Lib "user32" (ByVal hHook As Long) As Long

Declare Function GetActiveWindow Lib "user32" () As Long

Declare Function FindWindow Lib "user32" Alias "FindWindowA" _
                            (ByVal lpClassName As String, ByVal lpWindowName As String) As Long

Const HC_ACTION = 0
Const WH_MOUSE_LL = 14                ' Type of windows message to be hooked
Const WM_RBUTTONDOWN = &H204          ' Mouse message for right button down
Const WM_LBUTTONDOWN = &H201          ' Mouse message for left button down

Type KBDLLHOOKSTRUCT
    vkCode As Long
    scanCode As Long
    flags As Long
    time As Long
    dwExtraInfo As Long
End Type

Dim hkLowLevelID As Long             ' Hook id of the LowLevelMouseProc function
Dim LeftMouseDown As Boolean         ' Flag to trap left mouse down events
Dim RightMouseDown As Boolean        ' Flag to trap left mouse down events
Dim EllapsedTimer As Date

Function LowLevelMouseProc _
(ByVal nCode As Long, ByVal wParam As Long, lParam As KBDLLHOOKSTRUCT) As Long

On Error GoTo ResumeHere

    ' CAUTION !!!
    ' We can't do any action which envolves UI interaction because Excel is already beeing to update UI

    ' Hook mouse events only if XL is the active window
    If GetActiveWindow = FindWindow("XLMAIN", Application.Caption) Then
        If (nCode = HC_ACTION) Then
                        
            ' Check if the left button is pressed
            If (wParam = WM_LBUTTONDOWN) Then
                LeftMouseDown = True
                EllapsedTimer = Now() + TimeValue("00:00:01")
                Application.OnTime EllapsedTimer, "ResetFlags"
            
            ElseIf (wParam = WM_RBUTTONDOWN) Then
                RightMouseDown = True
                EllapsedTimer = Now() + TimeValue("00:00:01")
                Application.OnTime EllapsedTimer, "ResetFlags"
           
            End If
        End If
    End If
        
ResumeHere:
    ' Pass function to next hook if there is one
    LowLevelMouseProc = CallNextHookEx(0, nCode, wParam, ByVal lParam)

End Function
        
        
Function isLeftMouseDown()
    isLeftMouseDown = LeftMouseDown
End Function

Function isRightMouseDown()
    isRightMouseDown = RightMouseDown
End Function

' Reset the flags if the click has been thrown too long ago
Sub ResetFlags()
    RightMouseDown = False
    LeftMouseDown = False
End Sub

' Call this proc when opening Workbook
Sub StartHook()

    If (hkLowLevelID = 0) Then
        ' Initiate the hooking process
        hkLowLevelID = SetWindowsHookEx(WH_MOUSE_LL, AddressOf LowLevelMouseProc, Application.Hinstance, 0)
    End If
    
End Sub

' Call this proc when closing Workbook
Sub StopHook()

    If hkLowLevelID <> 0 Then
        UnhookWindowsHookEx hkLowLevelID
        hkLowLevelID = 0
    End If

End Sub

它定义了您在"ThisWoorkbook"中使用的2个过程StartHook和StopHook:

Private Sub Workbook_Open()
    Call StartHook
End Sub

Private Sub Workbook_BeforeClose(Cancel As Boolean)
    Call StopHook
End Sub

和2个函数,您可以在宏中使用的工作表如下:

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    
    ' Check if the mouse Left button was pressed
    If (isLeftMouseDown()) Then
    
        ... do some stuff on left click - for example ...
        If (ActiveCell.Column = 1) Then
            MsgBox "You LeftClick in column A"
        End If
        ...
    
    End If

End Sub

注意事项:

  • 该标志可以在单击事件后读取1秒,然后重置。这是为了防止退出Excel并返回时的一些副作用。
qcbq4gxm

qcbq4gxm2#

代码答案的附录:
从VBA 7及更高版本开始,开头的“Declare”语句还需要包括“PtrSafe”。Microsoft添加此检查以确保“Declare”语句在64位版本的Office中安全运行。请参阅此处的文章:
https://learn.microsoft.com/en-us/office/vba/language/concepts/getting-started/64-bit-visual-basic-for-applications-overview

相关问题