在 Excel 工作表的单元格中捕获按键完成事件

Question

VBA 有没有办法在 Excel 工作表中按下某个键后捕获事件？

这里回答了一个类似的问题： Is there any event that fires when keys are pressed when editing a cell?
这是带有答案的演示工作簿： http://www.321webs.com/download/30478.htm

这适用于捕获按键事件，检查并可能停止按键，但我想允许所有按键并在每个按键之后触发一个事件。

目的是在用户键入时捕获单元格值。如果用户正在输入“hello”，那么在目标单元格的这些状态下会触发一个事件：

1. “h”
2. “他”
3. “赫尔”
4. “地狱”
5. “你好”

如果用户使用退格或删除，它也会在每个实例之后捕获单元格内容。

Answer 1

那么您发布的示例有什么问题？让我们稍微更正一下。

把这个放到模块中

Option Explicit

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


Public pTemp As String
Public GlobalArray As Variant


Sub TrackKeyPressInit()

    Dim msgMessage As MSG
    Dim bCancel As Boolean
    Dim iKeyCode As Integer
    Dim lXLhwnd As Long
    GlobalArray = Array(19, 20, 46, 40, 35, 13, 27, 36, 45, 37, 144, 34, 33, 39, 145, 9, 38)
        'BACKSPACE  8
        'BREAK  19
        'CAPS LOCK  20
        'DELETE 46
        'DOWN ARROW 40
        'END    35
        'ENTER 13
        'ESC    27
        'HOME   36
        'INS    45
        'LEFT ARROW 37
        'NUM LOCK   144
        'PAGE DOWN  34
        'PAGE UP    33
        'RIGHT ARROW    39
        'SCROLL LOCK    145
        'TAB    9
        'UP ARROW   38
    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
            Sheet_KeyPress ByVal msgMessage.wParam, ByVal iKeyCode, ByVal Selection, bCancel
            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

Private Sub Sheet_KeyPress(ByVal KeyAscii As Integer, _
                           ByVal KeyCode As Integer, _
                           ByVal Target As Range, _
                           Cancel As Boolean)

    If Not Intersect(Target, Range("A1:D10")) Is Nothing Then
        If IsInArray(KeyAscii, GlobalArray) Then
            StopKeyWatch ' exit if pressed key in globalscope (restricted)
            Cancel = True
            SendKeys "{ENTER}" ' UPDATE CELL
        Else
            pTemp = pTemp & Chr(KeyAscii)
               Target.Offset(0) = pTemp
               Target.Offset(1) = pTemp
            Cancel = True
            Application.ScreenUpdating = True
        End If
    Else
        StopKeyWatch
    End If

End Sub

Function IsInArray(stringToBeFound As Integer, arr As Variant) As Boolean
    IsInArray = (UBound(Filter(arr, stringToBeFound)) > -1)
End Function

并将其放入活动工作表

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    pTemp = ""
    TrackKeyPressInit
End Sub