EXCEL单元格响应keypress事件

在国外网站上找到了,代码比较NB了

Option ExplicitPrivate Type POINTAPI    x As Long    y As LongEnd TypePrivate Type MSG    hwnd As Long    Message As Long    wParam As Long    lParam As Long    time As Long    pt As POINTAPIEnd TypePrivate Declare Function WaitMessage Lib "user32" () As LongPrivate 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 LongPrivate Declare Function TranslateMessage Lib "user32" _    (ByRef lpMsg As MSG) As LongPrivate Declare Function PostMessage Lib "user32" Alias "PostMessageA" _    (ByVal hwnd As Long, _     ByVal wMsg As Long, _     ByVal wParam As Long, _     lParam As Any) As LongPrivate Declare Function FindWindow Lib "user32" Alias "FindWindowA" _    (ByVal lpClassName As String, _     ByVal lpWindowName As String) As LongPrivate Const WM_KEYDOWN As Long = &H100Private Const PM_REMOVE  As Long = &H1Private Const WM_CHAR    As Long = &H102Private bExitLoop As BooleanSub TrackKeyPressInit()    Dim msgMessage As MSG    Dim bCancel As Boolean    Dim iKeyCode As Integer    Dim lXLhwnd As Long    On Error GoTo errHandler:        Application.EnableCancelKey = xlErrorHandler        'initialize this boolean flag.        bExitLoop = False        'get the app hwnd.        lXLhwnd = FindWindow("XLMAIN", Application.Caption)    Do        WaitMessage        'check for a key press and remove it from the msg queue.        If PeekMessage _            (msgMessage, lXLhwnd, WM_KEYDOWN, WM_KEYDOWN, PM_REMOVE) Then            'strore the virtual key code for later use.            iKeyCode = msgMessage.wParam           'translate the virtual key code into a char msg.            TranslateMessage msgMessage            PeekMessage msgMessage, lXLhwnd, WM_CHAR, _            WM_CHAR, PM_REMOVE           'for some obscure reason, the following          'keys are not trapped inside the event handler            'so we handle them here.            If iKeyCode = vbKeyBack Then SendKeys "{BS}"            If iKeyCode = vbKeyReturn Then SendKeys "{ENTER}"           'assume the cancel argument is False.            bCancel = False            'the VBA RaiseEvent statement does not seem to return ByRef arguments            'so we call a KeyPress routine rather than a propper event handler.            Sheet_KeyPress _            ByVal msgMessage.wParam, ByVal iKeyCode, ByVal Selection, bCancel            'if the key pressed is allowed post it to the application.            If bCancel = False Then                PostMessage _                lXLhwnd, msgMessage.Message, msgMessage.wParam, 0            End If        End IferrHandler:        'allow the processing of other msgs.        DoEvents    Loop Until bExitLoopEnd SubSub StopKeyWatch()    'set this boolean flag to exit the above loop.    bExitLoop = TrueEnd Sub'\\This example illustrates how to catch worksheet'\\Key strokes in order to prevent entering numeric'\\characters in the Range "A1:D10" .Private Sub Sheet_KeyPress(ByVal KeyAscii As Integer, _                           ByVal KeyCode As Integer, _                           ByVal Target As Range, _                           Cancel As Boolean)    Const MSG As String = _    "Numeric Characters are not allowed in" & _    vbNewLine & "the Range:  """    Const TITLE As String = "Invalid Entry !"    If Not Intersect(Target, Range("A1:D10")) Is Nothing Then        If Chr(KeyAscii) Like "[0-9]" Then            MsgBox MSG & Range("A1:D10").Address(False, False) _            & """ .", vbCritical, TITLE            Cancel = True        End If    End IfEnd Sub