C’è un evento che si triggers quando i tasti vengono premuti durante la modifica di una cella?

È in ogni modo ansible catturare gli eventi mentre premi una chiave (fai una modifica su) una cella specifica in un foglio di lavoro?

Il più vicino è noto è l’evento di Change ma può essere triggersto solo non appena la cella modificata viene deselezionata. Voglio catturare l’evento mentre sto modificando la cella.

Ecco la risposta, ho provato lo stesso e funziona correttamente per me.

Traccia il Keypress in Excel

Interessante domanda: l’evento Worksheet_Change MS Excel è sempre stato triggersto, quando hai finito le modifiche e sei uscito dalla cella. Per intrappolare l’evento Key Press . Il tracciamento dell’evento Keypress non è ansible con funzioni standard o built-in.

Questo può essere ottenuto utilizzando l’ API .

 Option Explicit 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 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 TranslateMessage Lib "user32" _ (ByRef lpMsg As MSG) 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 Declare Function FindWindow Lib "user32" Alias "FindWindowA" _ (ByVal lpClassName As String, _ ByVal lpWindowName As String) As Long Private Const WM_KEYDOWN As Long = &H100 Private Const PM_REMOVE As Long = &H1 Private Const WM_CHAR As Long = &H102 Private bExitLoop As Boolean Sub 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 If errHandler: 'allow the processing of other msgs. DoEvents Loop Until bExitLoop End Sub Sub StopKeyWatch() 'set this boolean flag to exit the above loop. bExitLoop = True End 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 If End Sub 

So che questa è una vecchia domanda, ma di recente avevo bisogno di funzionalità simili e la risposta fornita aveva alcune limitazioni che dovevo affrontare con il modo in cui gestiva (o non gestiva) il Del, il Backspace, i tasti funzione, ecc.

La correzione è di postare indietro il messaggio originale anziché quello tradotto.

Modificato anche per utilizzare un modulo di class con eventi poiché funziona correttamente in Excel 2010 e non volevo copiare lo stesso codice su più fogli:

Modulo di class

 Option Explicit 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 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 TranslateMessage Lib "user32" _ (ByRef lpMsg As MSG) 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 Declare Function FindWindow Lib "user32" Alias "FindWindowA" _ (ByVal lpClassName As String, _ ByVal lpWindowName As String) As Long Private Const WM_KEYDOWN As Long = &H100 Private Const PM_REMOVE As Long = &H1 Private Const WM_CHAR As Long = &H102 Private bExitLoop As Boolean Public Event KeyPressed (ByVal KeyAscii As Integer, _ ByVal KeyCode As Integer, _ ByVal Target As Range, _ ByRef Cancel As Boolean) Public Sub StartKeyPressInit() Dim msgMessage As MSG Dim bCancel As Boolean Dim iMessage As Integer 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 'Exit the loop if we were aborted If bExitLoop Then Exit Do 'Check for a key press and remove it from the msg queue. If PeekMessage(msgMessage, lXLhwnd, WM_KEYDOWN, WM_KEYDOWN, PM_REMOVE) Then 'Store the virtual key code for later use. iMessage = msgMessage.Message iKeyCode = msgMessage.wParam 'Translate the virtual key code into a char msg. TranslateMessage msgMessage PeekMessage msgMessage, lXLhwnd, WM_CHAR, WM_CHAR, PM_REMOVE bCancel = False RaiseEvent KeyPressed(msgMessage.wParam, iKeyCode, Selection, bCancel) 'If not handled, post back to the window using the original values If Not bCancel Then PostMessage lXLhwnd, iMessage, iKeyCode, 0 End If End If errHandler: 'Allow the processing of other msgs. DoEvents Loop Until bExitLoop End Sub Public Sub StopKeyPressWatch() 'Set this boolean flag to exit the above loop. bExitLoop = True End Sub 

uso

 Option Explicit Dim WithEvents CKeyWatcher As KeyPressApi Private Sub Worksheet_Activate() If CKeyWatcher Is Nothing Then Set CKeyWatcher = New KeyPressApi End If CKeyWatcher.StartKeyPressInit End Sub Private Sub Worksheet_Deactivate() CKeyWatcher.StopKeyPressWatch End Sub '\\This example illustrates how to catch worksheet '\\Key strokes in order to prevent entering numeric '\\characters in the Range "A1:D10" . Private Sub CKeyWatcher_KeyPressed(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 If End Sub 

Ho avuto lo stesso problema e l’ho risolto posizionando una casella di testo sulla cella. Ho impostato le proprietà in modo che la casella di testo assomigliasse a una cella di Excel, quindi ho utilizzato le proprietà Superiore e Sinistra per posizionarla sulla cella utilizzando le stesse proprietà dalla cella e impostare Larghezza e Altezza in modo che siano una più cellula. Quindi l’ho reso visibile. Ho usato l’evento KeyDown per elaborare le sequenze di tasti. Nel mio codice ho posizionato una casella di riepilogo sotto la cella per visualizzare gli elementi corrispondenti da un elenco su un altro foglio. Nota: questo codice era nel foglio, la variabile Cell è stata dichiarata in un modulo: Globale come intervallo. Funziona molto meglio di una casella combinata. tb1 è una casella di testo e lb1 è una casella di riepilogo. Avrai bisogno di un foglio chiamato Fruit con i dati nella prima colonna. Il foglio in cui viene eseguito questo codice verrà eseguito solo se la cella selezionata è in column = 2 ed è vuota. Non dimenticare di dichiarare Cell come sopra menzionato.

 Option Explicit Private Sub lb1_Click() Cell.Value2 = lb1.Value tb1.Visible = False lb1.Visible = False Cell.Activate End Sub Private Sub tb1_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer) Dim Row As Long Dim Temp As String Select Case KeyCode Case vbKeyBack If Len(tb1.Value) > 0 Then tb1.Value = Left(tb1.Value, Len(tb1.Value) - 1) Case vbKeySpace, vbKeyA To vbKeyZ tb1.Value = WorksheetFunction.Proper(tb1.Value & Chr(KeyCode)) Case vbKeyReturn If lb1.ListCount > 0 Then Cell.Value2 = lb1.List(0) Else Cell.Value2 = tb1.Value With Sheets("Fruit") .Cells(.UsedRange.Rows.Count + 1, 1) = tb1.Value .UsedRange.Sort Key1:=.Cells(1, 1), Header:=xlYes End With MsgBox tb1.Value & " has been added to the List" End If tb1.Visible = False lb1.Visible = False Cell.Activate Case vbKeyEscape tb1.Visible = False lb1.Visible = False Cell.Activate End Select lb1.Clear Temp = LCase(tb1.Value) & "*" With Sheets("Fruit") For Row = 2 To .UsedRange.Rows.Count If LCase(.Cells(Row, 1)) Like Temp Then lb1.AddItem .Cells(Row, 1) End If Next Row End With KeyCode = 0 End Sub Private Sub Worksheet_SelectionChange(ByVal Target As Range) If Target.Column = 2 And Target.Cells.Count = 1 Then If Target.Value2 = Empty Then Set Cell = Target With Cell tb1.Top = .Top tb1.Left = .Left tb1.Height = .Height + 1 tb1.Width = .Width + 1 End With tb1.Value = Empty tb1.Visible = True tb1.Activate With Cell.Offset(1, 0) lb1.Top = .Top lb1.Left = .Left lb1.Width = .Width + 1 lb1.Clear lb1.Visible = True End With Else tb1.Visible = False lb1.Visible = False End If Else tb1.Visible = False lb1.Visible = False End If End Sub