Capturing keypress in Excel Worksheet with VBA

'
' by http://www.experts-exchange.com
'


 Option Explicit
Declare Function SetWindowsHookEx Lib _
Declare Function CallNextHookEx Lib "user32" _
Declare Function UnhookWindowsHookEx Lib "user32" (ByVal hHook As Long) As Long
Declare Function GetActiveWindow Lib "user32" () As Long
Declare Function FindWindow Lib "user32" Alias "FindWindowA" _
Const HC_ACTION = 0
Type KBDLLHOOKSTRUCT
Enum AllowedValues


Function LowLevelKeyboardProc _
    '\hook keyboard only if XL is the active window
End Function
Public Sub Unhook_KeyBoard()
    If hhkLowLevelKybd <> 0 Then UnhookWindowsHookEx hhkLowLevelKybd
End Sub
Sub ValidateRange(r As Range, ByVal v As AllowedValues)
    '\store these in global variables for they will be
End Sub
Sub test()
    '\ignore any mishandling of the following
End Sub


"user32" Alias "SetWindowsHookExA" (ByVal idHook As Long, ByVal lpfn As Long, _
ByVal hmod As Long, ByVal dwThreadId As Long) As Long

(ByVal hHook As Long, ByVal nCode As Long, ByVal wParam As Long, lParam As Any) As Long



(ByVal lpClassName As String, ByVal lpWindowName As String) As Long

Const WM_KEYDOWN = &H100
Const WH_KEYBOARD_LL = 13
Dim hhkLowLevelKybd As Long
Dim blnHookEnabled As Boolean
Dim enumAllowedValues As AllowedValues
Dim objTargetRange As Range
Dim objValidationRange As Range
Dim vAns As Variant

    vkCode As Long
    scanCode As Long
    flags As Long
    time As Long
    dwExtraInfo As Long
End Type

    alpha
    numeric
End Enum

(ByVal nCode As Long, ByVal wParam As Long, lParam As KBDLLHOOKSTRUCT) As Long

    If GetActiveWindow = FindWindow("XLMAIN", Application.Caption) Then
        If (nCode = HC_ACTION) Then
            '\check if a key is pushed
            If wParam = WM_KEYDOWN Then
            '\if so, check if the active cell is within the target range
                If Union(ActiveCell, objTargetRange).Address = objTargetRange.Address Then
                '\if only numeric values should be allowed then
                    If enumAllowedValues = 1 Then
                    '\check if the pushed key is a numeric key or a navigation key
                    '\by checking the vkCode stored in the laparm parameter
                        If Chr(lParam.vkCode) Like "#" Or _
                            lParam.vkCode = 37 Or lParam.vkCode = 38 Or lParam.vkCode = 39 Or _
                            lParam.vkCode = 40 Or lParam.vkCode = 9 Or lParam.vkCode = 13 Then
                            '\if so allow the input
                            LowLevelKeyboardProc = 0
                        Else
                            '\else filter out this Key_Down message from message qeue
                            Beep
                            LowLevelKeyboardProc = -1
                            Exit Function
                        End If
                        '\if onle alpha values should be allowed then
                    ElseIf enumAllowedValues = 0 Then
                        '\check the laparam parameter
                        If Chr(lParam.vkCode) Like "#" Then
                            '\if numeric prevent the input
                            Beep
                            LowLevelKeyboardProc = -1
                            Exit Function
                        Else
                            '\otherwise allow the input
                            LowLevelKeyboardProc = 0
                    End If
                    End If
                End If
            End If
        End If
    End If
    '\pass function to next hook if there is one
    LowLevelKeyboardProc = CallNextHookEx(0, nCode, wParam, ByVal lParam)



    blnHookEnabled = False
    Cells.Clear



    '\needed later in the filter function
    enumAllowedValues = v
    Set objTargetRange = r
    '\don't hook the keyboard twice !!
    If blnHookEnabled = False Then
        hhkLowLevelKybd = SetWindowsHookEx _
        (WH_KEYBOARD_LL, AddressOf LowLevelKeyboardProc, Application.Hinstance, 0)
        blnHookEnabled = True
    End If



    '\input boxes by the user
    On Error Resume Next
    Cells.Clear
    Set objValidationRange = Application.InputBox _
    ("Selet one or more Cells ", "Custom Data Validation...", Type:=8)
    If objValidationRange Is Nothing Then GoTo errHdlr
        objValidationRange.Interior.Color = vbGreen
        vAns = InputBox("To allow only alpha values in the selected range enter 1 " _
        & vbCrLf & vbCrLf & "To allow only numeric values in the selected range enter 2 ")
        If vAns = 1 Then
            ValidateRange objValidationRange, AllowedValues.alpha
        ElseIf vAns = 2 Then
            ValidateRange objValidationRange, AllowedValues.numeric
        Else
        GoTo errHdlr
    End If
    objValidationRange.Cells(1).Select
    Set objValidationRange = Nothing
    Exit Sub
errHdlr:
    MsgBox "criteria error- Try again !", vbCritical
    Unhook_KeyBoard

Hidden Games in Microsoft Excel 2000

Follow the instructions to launch Trigger the egg game:

• Open a new workbook Press F5, type X97:L97 and press Enter.
• Press Tab Press Ctrl+Shift and Click on the Chart Wizard button from the toolbar.

You will be greeted with a full-screen animated image.  Use the mouse to “fly” over the landscape (the mouse changes direction, left button moves forward and right button moves backwards).  Fly around a bit and you will see a grey stone pyramid.  Fly to the side of the pyramid that’s black and you’ll see the credits scroll by for the developers.

Now, follow the instructions to launch a car racing/shooting game:

• Open a new workbook in Excel 2000
• Save as a web-page. Give any file name you wish. In the save as Window, select Selection:Sheet, add Interactivity and Publish as web-page. Click Publish
• Now, open your saved web-page.
• Reach Row 2000, column WC.
• Use “Shift+Space bar” to select whole row.
• Press ALT key+ Shift + Ctrl and click on the Microsoft Logo on the top left handed side of the sheet
• Enjoy the hidden game. The game is car chase/driving game. It gives you control of a car and you get to shoot other cars. Also has unlimited lives.