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

在Excel工作表中按下某个键后，VBA是否有方法捕获事件

这里回答了一个类似的问题：
这是演示工作簿，其答案如下：

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

目的是在用户键入时捕获单元格值。如果用户键入“hello”，则会在目标单元格的以下状态触发事件：

“h”

“他”

“hel”

“见鬼”

“你好”

---

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

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

把这个放到模块里

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

---

请分享您如何尝试根据您的需要调整该答案。例如，如果一个单元格有“h”，则有按键“e”，然后我尝试连接现有单元格，并在关闭事件的情况下将目标单元格更改为“he”。这完全不起作用。您是否有一个正在写入的特定单元格，并且需要从中捕获？我使用交叉点检查该单元格是否在命名范围内。如果超出该范围，我将关闭按键事件检查。这适用于消息框

MsgBox pTemp

。是否可以使用

Target.Offset（1）=pTemp使下面的单元格镜像正在编辑的单元格的内容？我试过了，它只对第一个字母有效，不允许更多的按键。