intercepting key strokes *within* the cell editor

[rpb]

Hello,

something I've been struggling with:

Is there a way to intercept what is being typed in while in the cell editor ? I would like to be able to enter non-excel commands in the cell box, and decide depending on what the string is whether or not I want excel to evaluate, or evaluate myself.

thanks in advance.

-Roger

 

[tusharm]

There's a method called subclassing that *should* let you intercept keystrokes but Excel can do strange things when it is in edit mode.

Also, FWIW, subclassing usually works but it can be a 'fragile' technique.

Search google for 'vb intercept keyboard input' (w/o the quotes).

 

[Jaafar Tribak]

I wrote a small dll sometime ago to avoid the problems associated with subclassing as mentioned by Tusharm. The dll is registration free and should be loaded automatically upon opening the workbook.

Workbook demo ( the dll bytes are stored in the "DllBytes" hidden worksheet)

Code in the Workbook module : (This example prevents entering numbers in cell A1. Change the code in the OnKeyPress event-like routine as required )

Option Explicit
 
Private Const DCOM_DLL_PATH_NAME As String _
= "C:\WINDOWS\system32\DirectCOM.dll"
 
Private Const JAAFAR_DLL_PATH_NAME As String _
= "C:\KeyPressWatcher.dll"

'CreateObject-Replacement (FileBased)
Private Declare Function GETINSTANCE Lib "DirectCom" _
(FName As String, ClassName As String) As Object

Private Declare Function UNLOADCOMDLL Lib "DirectCom" _
(FName As String, ClassName As String) As Long

Private oKeyPressInstance As Object


'=================================================================
'KeyPress custom event.
'Event Procedure Must be PUBLIC !!! and located in the workbook module.
'Use the ByRef Cancel argument to prevent the drop operation.

'Allow only Alpha characters in cell A1 of Sheets("test")
Public Sub OnKeyPress _
(ByVal Target As Range, ByVal KeyCode As Long, ByRef Cancel As Boolean)
    
    If ActiveSheet Is Sheets("test") Then
        If Target.Address = Range("a1").Address Then
            If IsNumeric(Chr(KeyCode)) Then
                MsgBox "No numeric characters are allowed in the range : " & _
                vbNewLine & Target.Address
                Cancel = True
            End If
        End If
    End If
    
End Sub
'=====================================================================


Private Sub Workbook_Open()

        'Create the DirectCom & KeyPressWatcher dlls.
        Call CreateDlls

        'load an instance of the 'KeyPressWatcher.dll' Class.
        Set oKeyPressInstance = _
        GETINSTANCE(JAAFAR_DLL_PATH_NAME, "KeyPressClass")

        If Not oKeyPressInstance Is Nothing Then
            'start watching user key strokes.
            Call oKeyPressInstance.Start(ThisWorkbook)
        Else
            MsgBox "Unable to load the " & _
            "'KeyPressWatcher' dll.", vbInformation
        End If

End Sub

Private Sub Workbook_BeforeClose(Cancel As Boolean)

    
    If Not oKeyPressInstance Is Nothing Then
        oKeyPressInstance.Finish
        Set oKeyPressInstance = Nothing
    End If

    UNLOADCOMDLL JAAFAR_DLL_PATH_NAME, "KeyPressClass"

    On Error Resume Next
    
    If Len(Dir(JAAFAR_DLL_PATH_NAME)) <> 0 Then
        Kill JAAFAR_DLL_PATH_NAME
    End If

End Sub



'Create the 'DirectCom' & 'KeyPressWatcher' dll from the
'Bytes stored in the '"DllBytes" hidden worksheet.
Private Sub CreateDlls()
 
    Dim Bytes() As Byte
    Dim lFileNum As Integer
    Dim aVar
    Dim x As Long
 
    On Error Resume Next
    
    If Len(Dir(JAAFAR_DLL_PATH_NAME)) = 0 Then
    
       With Worksheets("DllBytes")
           aVar = .Range(.Cells(1, 1), .Cells(.Rows.Count, 1).End(xlUp)).Value
       End With
     
       ReDim Bytes(LBound(aVar) To UBound(aVar))
       For x = LBound(aVar) To UBound(aVar)
           Bytes(x) = CByte(aVar(x, 1))
       Next
    
       lFileNum = FreeFile
       Open JAAFAR_DLL_PATH_NAME For Binary As #lFileNum
           Put #lFileNum, 1, Bytes
       Close lFileNum
    
    End If
    

    If Len(Dir(DCOM_DLL_PATH_NAME)) = 0 Then
    
        Erase Bytes
        
        With Worksheets("dllBytes")
            aVar = .Range(.Cells(1, 2), .Cells(.Rows.Count, 2).End(xlUp)).Value
        End With
        
        ReDim Bytes(LBound(aVar) To UBound(aVar))
        For x = LBound(aVar) To UBound(aVar)
            Bytes(x) = CByte(aVar(x, 1))
        Next
        lFileNum = FreeFile
        Open DCOM_DLL_PATH_NAME For Binary As #lFileNum
            Put #lFileNum, 1, Bytes
        Close lFileNum
        
    End If
    

End Sub