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

pgauzere · 13 Décembre 2018

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 · 13 Décembre 2018

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+

pgauzere · 13 Décembre 2018

Merci Job75 pour votre retour, je vais donc essayer de creuser la piste Textbox à laquelle je n'avais pas pensé :=)
A+

job75 · 14 Décembre 2018

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.

job75 · 14 Décembre 2018

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+

pgauzere · 14 Décembre 2018

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 · 14 Décembre 2018

Re,

pgauzere à dit:
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+

Si... · 14 Décembre 2018

Salut

Une autre proposition avec l'utilisation du clavier virtuel de Windows …

pgauzere · 14 Décembre 2018

Merci beaucoup a tous les deux pour ces deux propositions et le temps que vous avez passé.
Ca fonctionne nickel!
A+
Patrick.

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

pgauzere

XLDnaute Nouveau

job75

XLDnaute Barbatruc

pgauzere

XLDnaute Nouveau

job75

XLDnaute Barbatruc

Pièces jointes

job75

XLDnaute Barbatruc

Pièces jointes

pgauzere

XLDnaute Nouveau

job75

XLDnaute Barbatruc

Pièces jointes

Si...

XLDnaute Barbatruc

Pièces jointes

pgauzere

XLDnaute Nouveau

Discussions similaires