XL 2016 insérer valeur d'une touche dans cellule sans valider par Enter

pgauzere

XLDnaute Nouveau
Bonjour à tous,

et merci d’avance pour l’aide que vous pourrez m'apporter dans la résolution de la requête suivante:=)

Voila, imaginons qu’une cellule contienne un certain nombre de tirets (-), par exemple 3 (---). Je souhaiterais que dès que l’on appuie sur une touche alphanumérique du clavier ET sans faire Enter, la lettre correspondante remplace le premier tiret de la cellule et ceci jusqu’à ce que tous les tirets soient remplaces par les lettres tapées au fur et a mesure.

Par exemple : si je tape sur A (sans faire Enter), la cellule devient (A--), puis je tape sur B (sans faire Enter) la cellule devient (AB-) puis je tape sur C (sans faire Enter) la cellule devient (ABC). A la fin quand tous les tirets sont remplacés je peux valider par Enter, la cellule sera alors ABC.

Existe-t-il un code VBA pour faire cela ? j’ai bien pensé à utiliser Application.Onkey, le problème c’est que cette commande s’applique a une touche définie or je ne sais pas a l’avance quelle touche alphanumérique va être tapée…Merci pour vos précieuses idées !
 

job75

XLDnaute Barbatruc
Bonsoir pgauzere,

Une cellule étant sélectionnée, quand on appuie sur la touche "A" on passe en mode Edition.

Et alors aucune macro ne peut fonctionner, donc ce que vous souhaitez faire est impossible.

Ce serait bien sûr possible en utilisant une TextBox.

A+
 

job75

XLDnaute Barbatruc
Bonjour pgauzere, le forum,

Avec une TextBox on peut utiliser ces macros dans le code de la feuille :
Code:
Private Sub TextBox1_GotFocus()
TextBox1 = TextBox1 & 0 'pour positionner le curseur
End Sub

Private Sub TextBox1_Change()
Dim n%, comp$, t$, i
n = 3 'nombre de caractères autorisés, à adapter
comp = "-" 'complément à adapter
t = UCase(TextBox1) 'majuscules
For i = Len(t) To 1 Step -1
    If Asc(Mid(t, i, 1)) < 65 Or Asc(Mid(t, i, 1)) > 90 Then t = Left(t, i - 1) & Mid(t, i + 1)
Next
t = Left(t, n) 'limitation
i = Len(t)
TextBox1 = t & String(n - i, comp) 'complément
TextBox1.SelStart = i 'positionne le curseur
End Sub
A l'ouverture du fichier la TextBox est activée, dans ThisWorkbook :
Code:
Private Sub Workbook_Open()
Feuil1.OLEObjects("Textbox1").Activate
End Sub
Fichier joint.

Bonne journée.
 

Pièces jointes

  • TextBox(1).xlsm
    26.1 KB · Affichages: 9

job75

XLDnaute Barbatruc
Re,

Fichier (2) si l'on veut pouvoir entrer des lettres ou des chiffres :
Code:
Private Sub TextBox1_GotFocus()
TextBox1 = TextBox1 & "µ" 'pour positionner le curseur
End Sub

Private Sub TextBox1_Change()
Dim n%, comp$, t$, i, j
n = 3 'nombre de caractères autorisés, à adapter
comp = "-" 'complément à adapter
t = UCase(TextBox1) 'majuscules
For i = Len(t) To 1 Step -1
    j = Asc(Mid(t, i, 1))
    If j < 48 Or j > 57 And j < 65 Or j > 90 Then t = Left(t, i - 1) & Mid(t, i + 1)
Next
t = Left(t, n) 'limitation
i = Len(t)
TextBox1 = t & String(n - i, comp) 'complément
TextBox1.SelStart = i 'positionne le curseur
End Sub
A+
 

Pièces jointes

  • TextBox(2).xlsm
    26.2 KB · Affichages: 13

pgauzere

XLDnaute Nouveau
Merci beaucoup Job75, ca fonctionne tres bien :=)
Serait il juste possible de rajouter la possibilite d'utiliser les touches espace et apostrophe en plus des touches alphanumeriques et chiffres?
Merci en tout cas pour ce code qui couvre deja 90% de mes besoins.
A+
 

job75

XLDnaute Barbatruc
Re,
Serait il juste possible de rajouter la possibilite d'utiliser les touches espace et apostrophe en plus des touches alphanumeriques et chiffres?
Fichier (3) avec cette modification :
Code:
    If j <> 32 And j <> 39 Then If j < 48 Or j > 57 And j < 65 Or j > 90 Then t = Left(t, i - 1) & Mid(t, i + 1)
A+
 

Pièces jointes

  • TextBox(3).xlsm
    26.6 KB · Affichages: 10
Haut Bas