我可以在 Excel VBA 中捕获和模拟 KeyDown 事件吗？

Can I capture and emulate a KeyDown event in Excel VBA?

提问by chris

Arun Singh gave a great answer to a similar question (Is there any event that fires when keys are pressed when editing a cell?). I want to set a flag to prevent execution of Selection_Change event if the user is scrolling with the arrow keys.

Arun Singh 对类似问题给出了很好的答案（编辑单元格时按下键时是否会触发任何事件？）。如果用户使用箭头键滚动，我想设置一个标志以防止执行 Selection_Change 事件。

回答by Siddharth Rout

It's pretty easy actually. I am demostrating it for UPand DOWNarrow key. You may add more to it like RIGHT/LEFT/TAB/ENTERetc... I have commented the part where you can add the keys.

其实很容易。我正在为UP和DOWN箭头键演示它。您可以添加更多内容，例如RIGHT/LEFT/TAB/ENTER等...我已经评论了您可以添加键的部分。

Paste this in the worksheet code area

将此粘贴到工作表代码区域中

Option Explicit

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    If CancSelEvnt = False Then
        '
        '~~> Rest of the code for the Selection Change
        '
    Else
        '~~> Only for demostration purpose. Remove Msgbox later
        MsgBox "User pressed one of the navigation keys"

        CancSelEvnt = False
    End If
End Sub

Paste this in a module

将此粘贴到模块中

Option Explicit

'~~> We need this as this will help us in cancelling the
'~~> Selection chnage event
Public CancSelEvnt As Boolean

Private Type POINTAPI
    x As Long
    y As Long
End Type

Private Type MSG
    hwnd As Long
    Message As Long
    wParam As Long
    lParam As Long
    time As Long
    pt As POINTAPI
End Type

Private Declare Function WaitMessage Lib "user32" () As Long

Private Declare Function PeekMessage Lib "user32" Alias "PeekMessageA" _
    (ByRef lpMsg As MSG, ByVal hwnd As Long, _
     ByVal wMsgFilterMin As Long, _
     ByVal wMsgFilterMax As Long, _
     ByVal wRemoveMsg As Long) As Long

Private Declare Function TranslateMessage Lib "user32" _
    (ByRef lpMsg As MSG) As Long

Private Declare Function PostMessage Lib "user32" Alias "PostMessageA" _
    (ByVal hwnd As Long, _
     ByVal wMsg As Long, _
     ByVal wParam As Long, _
     lParam As Any) As Long

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

Private Const WM_KEYDOWN As Long = &H100
Private Const PM_REMOVE  As Long = &H1
Private Const WM_CHAR    As Long = &H102
Private bExitLoop As Boolean

Sub StartKeyWatch()
    Dim msgMessage As MSG
    Dim bCancel As Boolean
    Dim iKeyCode As Integer
    Dim lXLhwnd As Long

    On Error GoTo errHandler:
    Application.EnableCancelKey = xlErrorHandler
    bExitLoop = False
    lXLhwnd = FindWindow("XLMAIN", Application.Caption)
    Do
        WaitMessage
        If PeekMessage _
            (msgMessage, lXLhwnd, WM_KEYDOWN, WM_KEYDOWN, PM_REMOVE) Then
            iKeyCode = msgMessage.wParam
            TranslateMessage msgMessage
            PeekMessage msgMessage, lXLhwnd, WM_CHAR, _
            WM_CHAR, PM_REMOVE
            If iKeyCode = vbKeyBack Then SendKeys "{BS}"
            If iKeyCode = vbKeyReturn Then SendKeys "{ENTER}"
            bCancel = False

            '
            '~~> This is the main part where we check what key is pressed
            '

            If iKeyCode = vbKeyDown Then   '<~~ Down
                SendKeys "{DOWN}"
                CancSelEvnt = True
            ElseIf iKeyCode = vbKeyUp Then '<~~ UP
                SendKeys "{UP}"
                CancSelEvnt = True
            '
            '~~> And so on for the rest of the navigation keys
            '
            Else
                CancSelEvnt = False
            End If

            If bCancel = False Then
                PostMessage _
                lXLhwnd, msgMessage.Message, msgMessage.wParam, 0
            End If
        End If
errHandler:
        DoEvents
    Loop Until bExitLoop
End Sub

Sub StopKeyWatch()
    bExitLoop = True
End Sub

And here is something that you may need ;)

这是您可能需要的东西;）

VBKey Code List

VBKey代码列表

vbKeyLButton    Left Mouse Button
vbKeyRButton    Right Mouse Button
vnKeyCancel     Cancel Key
vbKeyMButton    Middle Mouse button
vbKeyBack       Back Space Key
vbKeyTab        Tab Key
vbKeyClear      Clear Key
vbKeyReturn     Enter Key
vbKeyShift      Shift Key
vbKeyControl    Ctrl Key
vbKeyMenu       Menu Key
vbKeyPause      Pause Key
vbKeyCapital    Caps Lock Key
vbKeyEscape     Escape Key
vbKeySpace      Spacebar Key
vbKeyPageUp     Page Up Key
vbKeyPageDown   Page Down Key
vbKeyEnd        End Key
vbKeyHome       Home Key
vbKeyLeft       Left Arrow Key
vbKeyUp         Up Arrow Key
vbKeyRight      Right Arrow Key
vbKeyDown       Down Arrow Key
vbKeySelect     Select Key
vbKeyPrint      Print Screen Key
vbKeyExecute    Execute Key
vbKeySnapshot   Snapshot Key
vbKeyInsert     Insert Key
vbKeyDelete     Delete Key
vbKeyHelp       Help Key
vbKeyNumlock    Delete Key

vbKeyA through vbKeyZ are the key code constants for the alphabet
vbKey0 through vbKey9 are the key code constants for numbers
vbKeyF1 through vbKeyF16 are the key code constants for the function keys
vbKeyNumpad0 through vbKeyNumpad9 are the key code constants for the numeric key pad

Math signs are:
vbKeyMultiply      -  Multiplication Sign (*)
vbKeyAdd             - Addition Sign (+)
vbKeySubtract     - Minus Sign (-)
vbKeyDecimal    - Decimal Point (.)
vbKeyDivide        - Division sign (/)
vbKeySeparator  - Enter (keypad) sign

And Of course THISmsdn link for the key codes.

当然，关键代码的这个msdn 链接。

回答by mkvarious

I need to adjust the above to work with Worksheet_Change and Tab key as basically when tab key is pressed then changes the Target (when A2 is edited and Tab key pressed, Change event shows cell B2) which I want to avoid.

我需要调整上面的内容以使用 Worksheet_Change 和 Tab 键，基本上是在按下 Tab 键时更改目标（当编辑 A2 并按下 Tab 键时，更改事件显示单元格 B2），这是我想避免的。

I have changed the key part to:

我已将关键部分更改为：

        If iKeyCode = vbKeyTab Then   '<~~ Tab
            SendKeys "{TAB}"
            CancSelEvnt = True
        Else
            CancSelEvnt = False
        End If<code>

but am struggling to get any result on that?

但正在努力获得任何结果吗？

When I press Tab key then my Change event does not call Sub StartKeyWatch() at all. also calling Sub StartKeyWatch() from Worksheet_Change directly does not seem to be doing anything...

当我按下 Tab 键时，我的 Change 事件根本不会调用 Sub StartKeyWatch()。也直接从 Worksheet_Change 调用 Sub StartKeyWatch() 似乎没有做任何事情......

what am I missing here?

我在这里错过了什么？

thanks, mkvarious

谢谢，mkvarious