Cool Worksheet KeyDown Event (like the one for TextBoxes) & w/out Subclassing

Thanks Thanks:  0
Likes Likes:  0
Results 1 to 2 of 2

Thread: Cool Worksheet KeyDown Event (like the one for TextBoxes) & w/out Subclassing

  1. #1
    Board Regular Jaafar Tribak's Avatar
    Join Date
    Dec 2002
    Post Thanks / Like
    1 Post(s)
    0 Thread(s)

    Default Cool Worksheet KeyDown Event (like the one for TextBoxes) & w/out Subclassing

    Hi all,

    I have been trying to create a keyDown event for worksheets for some time and i believe i have arrived at something that is probably worth sharing. This missing worksheet event can come in handy sometimes and i have seen a few requests for it but as we know,it's not possible to trap keyboard letters as you type them in an excel workshhet before leaving the cell concerned.Thre is just no such event.

    here is a workbook demo:

    for the record, here is the code. It goes in a Standard module :

    Option Explicit
    Const vbKeyBack = 8
    Const vbKeyTab = 9
    Const vbKeyClear = 12
    Const vbKeyReturn = 13
    Const vbKeyShift = 16
    Const vbKeyControl = 17
    Const vbKeyMenu = 18
    Const vbKeyPause = 19
    Const vbKeyCapital = 20
    Const vbKeyEscape = 27
    Const vbKeySpace = 32
    Const vbKeyPageUp = 33
    Const vbKeyPageDown = 34
    Const vbKeyEnd = 35
    Const vbKeyHome = 36
    Const vbKeyLeft = 37
    Const vbKeyUp = 38
    Const vbKeyRight = 39
    Const vbKeyDown = 40
    Const vbKeySelect = 41
    Const vbKeyPrint = 42
    Const vbKeyExecute = 43
    Const vbKeySnapshot = 44
    Const vbKeyInsert = 45
    Const vbKeyDelete = 46
    Const vbKeyHelp = 47
    Const vbKeyNumlock = 144
    Const vbKeyF1 = 112
    Const vbKeyF2 = 113
    Const vbKeyF3 = 114
    Const vbKeyF4 = 115
    Const vbKeyF5 = 116
    Const vbKeyF6 = 117
    Const vbKeyF7 = 118
    Const vbKeyF8 = 119
    Const vbKeyF9 = 120
    Const vbKeyF10 = 121
    Const vbKeyF11 = 122
    Const vbKeyF12 = 123
    Const vbKeyF13 = 124
    Const vbKeyF14 = 125
    Const vbKeyF15 = 126
    Const vbKeyF16 = 127
    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 TranslateMessage Lib "User32" _
    (ByRef lpMsg As MSG) 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 FindWindow Lib _
    "User32" Alias "FindWindowA" _
    (ByVal lpClassName As String, ByVal lpWindowName As String) 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 Const WM_KEYDOWN = &H100
    Private Const WM_CHAR As Long = &H102
    Private Const PM_REMOVE As Long = &H1
    Private Const PM_NOREMOVE = &H0
    Private Const PM_NOYIELD As Long = &H2
    Private bCancelLoop As Boolean
    Private bCancel As Boolean
    Sub StartEvent()
        Dim msgMessage As MSG
        Dim lHwnd As Long
        bCancelLoop = False
        'get the xl window handle
        lHwnd = FindWindow("XLMAIN", Application.Caption)
        'start loop to monitior key presses
        Do While Not bCancelLoop
            'wait for an input message.
            'check for a key press
            If PeekMessage _
                (msgMessage, lHwnd, WM_KEYDOWN, WM_KEYDOWN, PM_REMOVE) Then
                'if the key pressed is a navigation ot Function key implement it
                If Is_Navigation_Or_Function_Key(msgMessage.wParam) _
                Then GoTo ImplementKey
                'for all other keys retrieve their ascii codes and
                'send them to our event handler
                TranslateMessage msgMessage
                PeekMessage msgMessage, lHwnd, WM_CHAR, _
                WM_CHAR, PM_REMOVE
                'reset flag
                bCancel = False
                Call Worksheet_OnKeyEvent(ActiveCell, Chr(msgMessage.wParam), bCancel)
                If Not bCancel Then
                    'implement all wanted key presses by the user
                    Call PostMessage(lHwnd, msgMessage.Message, msgMessage.wParam, 0)
                End If
            End If
        MsgBox "you terminated the OnKey Event", vbInformation
    End Sub
    Sub TerminateEvent()
        bCancelLoop = True
    End Sub
    Private Function Is_Navigation_Or_Function_Key(KeyCode As Long) As Boolean
        Dim vArRet As Variant
        Dim lRet As Long
        vArRet = Array(vbKeyBack, vbKeyTab, vbKeyClear, vbKeyReturn, vbKeyShift, _
        vbKeyControl, vbKeyMenu, vbKeyPause, vbKeyCapital, vbKeyEscape, _
        vbKeySpace, vbKeyPageUp, vbKeyPageDown, vbKeyEnd, vbKeyHome, _
        vbKeyLeft, vbKeyUp, vbKeyRight, vbKeyDown, vbKeySelect, vbKeyPrint, _
        vbKeyExecute, vbKeySnapshot, vbKeyInsert, vbKeyDelete, vbKeyHelp, _
        vbKeyNumlock, vbKeyF1, vbKeyF2, vbKeyF3, vbKeyF4, vbKeyF5, _
        vbKeyF6, vbKeyF7, vbKeyF8, vbKeyF9, vbKeyF10, vbKeyF11, vbKeyF12, _
        vbKeyF13, vbKeyF14, vbKeyF15, vbKeyF16)
        On Error Resume Next
        lRet = WorksheetFunction.Match(KeyCode, vArRet, 0)
        If Err.Number = 0 Then Is_Navigation_Or_Function_Key = True
    End Function
    '**** here is the OnKeyEvent handler ******
    'this example will prevent the pressing of the "a" Key
    'and will completly block any keyboad input into range A
    'adapt the handler code as required like you do in
    'standard excel native event.
    Private Sub Worksheet_OnKeyEvent _
    (ByRef InputCell As Range, ByRef Key As String, ByRef Cancel As Boolean)
        If Key = "a" Then
            Cancel = True
            MsgBox "You Can't Press the ""a"" Key", vbCritical
        End If
        If InputCell.Address = Range("a1").Address Then
            Cancel = True
            MsgBox "You can't edit cell 'A1'", vbExclamation
        End If
    End Sub
    Needs some more robust error handling. Open to comments & suggestions.

    Last edited by Jaafar Tribak; Mar 6th, 2009 at 12:19 PM.
    Office/Excel 2010 64Bits -- Win10 64Bits

    Common sense is not so common.

  2. #2
    Board Regular
    Join Date
    Sep 2013
    Post Thanks / Like
    0 Post(s)
    0 Thread(s)

    Default Re: Cool Worksheet KeyDown Event (like the one for TextBoxes) & w/out Subclassing

    Jaafar Tribak, I tried this (I hope that the post being old will not matter), but I could not intercept a control+key event. What I want to do is a Ctrl+Z for an undo because Excel dumps the undo buffer if Worksheet_SelectionChange is used. thanks...

User Tag List

Like this thread? Share it with others

Like this thread? Share it with others

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts