Results 1 to 2 of 2

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

This is a discussion on Cool Worksheet KeyDown Event (like the one for TextBoxes) & w/out Subclassing within the Excel Questions forums, part of the Question Forums category; Hi all, I have been trying to create a keyDown event for worksheets for some time and i believe i ...

  1. #1
    Board Regular Jaafar Tribak's Avatar
    Join Date
    Dec 2002
    Location
    Larache--Morocco
    Posts
    4,950

    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:

    http://www.savefile.com/files/2029271

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

    Code:
     
    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.
            WaitMessage
            '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
    ImplementKey:
                    'implement all wanted key presses by the user
                    Call PostMessage(lHwnd, msgMessage.Message, msgMessage.wParam, 0)
                End If
            End If
            DoEvents
        Loop
        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.

    Regards.
    Last edited by Jaafar Tribak; Mar 6th, 2009 at 11:19 AM.
    Office/Excel 2007 Win XP

    Common sense is not so common.


    http://photo-larache.blogspot.com/

  2. #2
    Board Regular
    Join Date
    Sep 2013
    Posts
    86

    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...

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
  •  


DMCA.com