Y a-t-il un événement qui se déclenche lorsque les touches sont enfoncées lors de la modification d'une cellule?

Est en aucune façon possible de capturer des événements comme vous appuyez sur une touche (apporter une modification à une cellule dans une feuille de calcul?

La plus proche est à savoir, c'est le Change Événement, mais qui ne peut être activé dès la cellule modifiée est désélectionnée. Je veux capturer l'événement tout je suis en train de modifier la cellule.

source d'informationauteur Daan

Voici la réponse, j'ai testé le même et il fonctionne correctement pour moi.

Suivi de la Touche dans Excel

Question Intéressante:
MS Excel est Worksheet_Change événement toujours tiré, quand vous avez terminé vos modifications et sortir de la cellule. Pour piéger les Key Press événement. Le suivi de l'événement Keypress n'est pas possible avec excel standard ou de fonctions intégrées.

Ceci peut être réalisé à l'aide de la 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

Je sais que c'est une vieille question, mais j'ai récemment eu besoin des fonctionnalités similaires et la condition de répondre a certaines limites que j'ai eu à traiter avec la façon dont il a traité (ou n'a pas de poignée) de la Del, retour arrière, Touches de Fonction, etc.

Le correctif est de retour le message d'origine au lieu de la traduction.

A également été modifié pour utiliser un Module de Classe avec des Événements depuis il fonctionne très bien dans Excel 2010 et je n'ai pas envie de copier le même code à plusieurs feuilles:

Module De Classe

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

Utilisation

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

J'ai eu le même problème, résolu en plaçant une zone de texte sur la cellule. Je définissez les propriétés de sorte que la zone de texte ressemblait à une cellule Excel, puis utilisé les propriétés Top et Left de le positionner sur la cellule en utilisant les mêmes propriétés de la cellule, et de définir la Largeur et la Hauteur soit un de plus que celui de la cellule. Puis j'ai fait visible. J'ai utilisé l'événement KeyDown pour traiter les touches. Dans mon code, je l'ai placé une zone de liste en vertu de la cellule pour afficher les éléments correspondants à partir d'une liste sur une autre feuille. Remarque: Ce code a été dans la feuille, la Cellule variable a été déclarée dans un module Global de la Cellule comme un choix. Cela fonctionne beaucoup mieux qu'un combo. tb1 est une zone de texte, et lb1 est une zone de liste. Vous aurez besoin d'une feuille nommée Fruits avec les données de la première colonne. La feuille que ce code s'exécute en sera exécuté uniquement si la cellule sélectionnée est dans la colonne = 2, et est vide. N'oubliez pas de déclarer la Cellule comme mentionné ci-dessus.

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

Vous devez vous connecter pour publier un commentaire.