XL 2010 Format Textbox dynamique

cathodique

XLDnaute Barbatruc
Bonjour,

Au fil de mes recherches, j'ai trouvé des codes très intéressants de notre ami @patricktoulon (;) que je salue pour sa gentillesse en mp).
Ses codes sont à garder précieusement. Mais je n'ai pas toutes les connaissances pour les adapter à mes attentes.
Je voudrais un masque de saisie suivant: Textbox numérique (2 décimales) avec séparateur de milliers en dynamique et possibilité de retour arrière pour correction faute de frappe.
J'espère que mes explications sont claires.
Bon dimanche.
 

Pièces jointes

  • NUM avec Sep Millier dynamique.xlsm
    18.7 KB · Affichages: 2
Solution
voila
et noyeux joel
VB:
Option Explicit

Private Sub TextBox1_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
'patricktoulon
'textbox (million millier mille) formaté dynamico aux taper des touches
'la touche (BACK ;retour en arrière) est fonctionnelle  
  Dim v  'j'ai juste ajouté ce dim car le code planté
    With TextBox1
        v = Replace(.Value, " ", "")
        Select Case KeyCode
        Case 96 To 105, 48 To 57
            If KeyCode < 96 Then KeyCode = KeyCode + 48
            If InStr(1, v, ",") > 0 Then
                If Len(Split(v, ",")(1)) = 2 Then KeyCode = 0: Exit Sub
            Else
                'v = v & Chr(KeyCode - 48): KeyCode = 0
                v = Split(Format(v & Chr(KeyCode - 48)...

job75

XLDnaute Barbatruc
Avec mon code précédent on peut entrer le séparateur décimal à la place des décimales.

Avec ce nouveau code un seul séparateur peut être entré :
VB:
Private Sub TextBox1_Change()
Dim sep$, pos%
With TextBox1
    If .Text = "" Then Exit Sub
    sep = Application.DecimalSeparator
    If Not IsNumeric(Left(.Text, 1)) Then .Text = "" Else If Not IsNumeric(Right(.Text, 1)) And Right(.Text, 1) <> sep Then .Text = Left(.Text, Len(.Text) - 1)
    pos = InStr(.Text, sep)
    If pos Then
        .Text = Left(.Text, pos) & Replace(Mid(.Text, pos + 1), sep, "")
        If Len(Mid(.Text, pos)) > 2 Then .Text = Format(Left(.Text, pos + 2), "#,##0.00")
    Else
        .Text = Format(.Text, "#,##0")
    End If
End With
End Sub
 

job75

XLDnaute Barbatruc
mais pas pratique de devoir saisir une virgule car j'utilise un pavé numérique (la touche (.) de ce dernier ne fonctionne pas.
En effet chez moi sur Win 11 Excel 2019 le point du pavé numérique :

- renvoie une virgule sur une cellule

- mais renvoie un point dans une TextBox.

Alors il suffit de remplacer le point par le séparateur décimal :
VB:
Private Sub TextBox1_Change()
Dim sep$, pos%
With TextBox1
    If .Text = "" Then Exit Sub
    sep = Application.DecimalSeparator
    .Text = Replace(.Text, ".", sep) 'on peut entrer le point
    If Not IsNumeric(Left(.Text, 1)) Then .Text = "" Else If Not IsNumeric(Right(.Text, 1)) And Right(.Text, 1) <> sep Then .Text = Left(.Text, Len(.Text) - 1)
    pos = InStr(.Text, sep)
    If pos Then
        .Text = Left(.Text, pos) & Replace(Mid(.Text, pos + 1), sep, "")
        If Len(Mid(.Text, pos)) > 2 Then .Text = Format(Left(.Text, pos + 2), "#,##0.00")
    Else
        .Text = Format(.Text, "#,##0")
    End If
End With
End Sub
Maintenant vous pouvez utiliser le point du pavé numérique.
 

patricktoulon

XLDnaute Barbatruc
re
Bonjou Bonjour ;)
apres 4 heure de someil
un foi qui a triplé de dimension
au lever j'ai cogité sur ta version @job75
et finalement j'en suis arrivé à la conclusion
que le formatage décimal n'etait pas nécessaire
2°travailler sur une variable plutot que le .text
et changer la valeur du .text a la fin pour eviter les double voir triple change
VB:
Private Sub TextBox1_Change()
    Dim v$
    With TextBox1
        v = Replace(.Text, ".", ","): If v = "" Then Exit Sub
        If Not IsNumeric(Right(v, 1)) And Not Right(v, 1) = "," Then v = Left(v, Len(v) - 1)
        If InStr(v, ",") Then
            If Len(v) - InStrRev(v, ",") > 2 Then v = Mid(v, 1, InStr(v, ",") + 2)
        Else: v = Format(v, "#,##0")
        End If
        .Text = v
    End With
End Sub
le formatage decimal n'est pas necéssaire car les deux chiffres après la virgule n'ont pas a avoir un format particulier (2 chiffres après la virgule c'est tout )
comme quoi des fois on se casse la tête pour rien ;)
 

Eric C

XLDnaute Barbatruc
Bonjour le forum
Bonjour le fil

Je like vos versions et sur celle de Patrick (#18), il y a un petit soucis que je ne parviens pas à régler, à savoir que l'on peut autoriser la saisie de plusieurs séparateurs (un détail mais avec les utilisateurs ....). J'ai tenté d'intégrer ce code mais en vain :
VB:
Private Sub TextBox1_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
If InStr(TextBox1.Value, ",") <> 0 And Chr(KeyAscii) = "," Then KeyAscii = 0: Beep
End Sub

Joyeux Noël à toutes & à tous et encore chapeau bas à tous nos athlètes du forum.
Eric c
 

cathodique

XLDnaute Barbatruc
Bonjour,

Ce matin, j'espère que tout le monde est sobre 😇.

@patricktoulon : J'ai retesté ton code et il s'avère qu'il plante dès lors qu'on tape la virgule en premier.
Comme beaucoup de personne, j'ai pris l'habitude pour les nombres inférieurs à 1 de m'affranchir de taper le 0.

Code patrick.gif


@job75 : Ton dernier code ne réagit pas lorsque je tape la virgule en premier, mais ne plante pas. Il oblige à taper au moins un chiffre pour accepter la virgule (point du clavier numérique).

Je ne voudrais pas abuser mais serait-il possible d'ajouter le (0) zéro dès lors qu'on tape le séparateur de décimal du clavier numérique?

Avec mes remerciements anticipées.

Bon journée.

ps: fichier joint du post#1 modifier
 

job75

XLDnaute Barbatruc
Bonjour cathodique, Eric C,
Je ne voudrais pas abuser mais serait-il possible d'ajouter le (0) zéro dès lors qu'on tape le séparateur de décimal du clavier numérique?
C'est bien simple :
VB:
Private Sub TextBox1_Change()
Dim sep$, pos%
With TextBox1
    If .Text = "" Then Exit Sub
    sep = Application.DecimalSeparator
    .Text = Replace(.Text, ".", sep) 'on peut entrer le point
    If .Text = sep Then .Text = 0 & sep
    If Not IsNumeric(Left(.Text, 1)) Then .Text = "" Else If Not IsNumeric(Right(.Text, 1)) And Right(.Text, 1) <> sep Then .Text = Left(.Text, Len(.Text) - 1)
    pos = InStr(.Text, sep)
    If pos Then
        .Text = Left(.Text, pos) & Replace(Mid(.Text, pos + 1), sep, "")
        .Text = Left(.Text, pos + 2)
    Else
        .Text = Format(.Text, "#,##0")
    End If
End With
End Sub
A+
 

patricktoulon

XLDnaute Barbatruc
re
Bonsoir
si j'ai bien compris
VB:
Option Explicit

Private Sub TextBox1_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
'patricktoulon
'textbox (million millier mille) formaté dynamico aux taper des touches
'la touche (BACK ;retour en arrière) est fonctionnelle
  Dim v  'j'ai juste ajouté ce dim car le code planté
    With TextBox1
        v = Replace(.Value, " ", "")
        Select Case KeyCode
        Case 96 To 105, 48 To 57
            If KeyCode < 96 Then KeyCode = KeyCode + 48
            If InStr(1, v, ",") > 0 Then
                If Len(Split(v, ",")(1)) = 2 Then KeyCode = 0: Exit Sub
            Else
                'v = v & Chr(KeyCode - 48): KeyCode = 0
                v = Split(Format(v & Chr(KeyCode - 48), "#,##0.00"), ",")(0): KeyCode = 0
            End If
            .Value = v
        Case 110, 188: KeyCode = 188 ' la virgule prime
            If .Value = "" Then .Value = "0,": KeyCode = 0: Exit Sub
            If InStr(1, .Value, ",") > 0 Then KeyCode = 0
            v = Split(Format(v, "#,##0.00"), ",")(0)
            .Value = v & ",": KeyCode = 0
        Case 8    'gestion de la touche back
            If v = "" Then KeyCode = 0: Exit Sub
            v = Left(v, Len(v) - 1)
            If v = "" Then Exit Sub
            If InStr(1, v, ",") = 0 Then v = Split(Format(v, "#,##0.00"), ",")(0)
            .Value = v: KeyCode = 0
        Case 13, 9
            .Value = Format(.Value, "#,##0.00") 'au cas ou on sort et que ce n'est pas fini
        Case Else: KeyCode = 0    'Toutes les autres touches sont bloquées
        End Select
    End With
End Sub
 

patricktoulon

XLDnaute Barbatruc
et la version avec le change
VB:
Private Sub TextBox1_Change()
    Dim v$
    With TextBox1
        v = Replace(.Text, ".", ","): If v = "" Then Exit Sub
        If v = "," Then v = "0,"
        If Not IsNumeric(Right(v, 1)) And Not Right(v, 1) = "," Then v = Left(v, Len(v) - 1)
        If InStr(v, ",") Then
            If Len(v) - InStrRev(v, ",") > 2 Then v = Mid(v, 1, InStr(v, ",") + 2)
        Else: v = Format(v, "#,##0")
        End If
        .Text = v
    End With
End Sub
 

patricktoulon

XLDnaute Barbatruc
Bonjour le forum
Bonjour le fil

Je like vos versions et sur celle de Patrick (#18), il y a un petit soucis que je ne parviens pas à régler, à savoir que l'on peut autoriser la saisie de plusieurs séparateurs (un détail mais avec les utilisateurs ....). J'ai tenté d'intégrer ce code mais en vain :
VB:
Private Sub TextBox1_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
If InStr(TextBox1.Value, ",") <> 0 And Chr(KeyAscii) = "," Then KeyAscii = 0: Beep
End Sub

Joyeux Noël à toutes & à tous et encore chapeau bas à tous nos athlètes du forum.
Eric c
re
Bonsoir @Eric C
il est est bien là le soucis avec l'event change
alors oui on peut arriver a le boquer mais il n'y a pas que ca comme soucis avec l'event change
c'est pour ca que je préfère gérer tout dans le case 96 to 105,48 to 57 dans le select case keycode de l'event keydown

avec cet event on intercepte tandis qu'avec l'event change on corrige (ce qui renouvelle a chaque fois l'event bien sur
alors pour le double voir plus de separateur
on rajoute une ligne de test avec un like car les separateurs peuvent être séparés par des chiffres

VB:
Private Sub TextBox1_Change()
    Dim v$
    With TextBox1
        v = Replace(.Text, ".", ","): If v = "" Then Exit Sub
        If v = "," Then v = "0,"
        If v Like "*,*," Then v = Left(v, Len(v) - 1)
        If Not IsNumeric(Right(v, 1)) And Not Right(v, 1) = "," Then v = Left(v, Len(v) - 1)
        If InStr(v, ",") Then
            If Len(v) - InStrRev(v, ",") > 2 Then v = Mid(v, 1, InStr(v, ",") + 2)
        Else: v = Format(v, "#,##0")
        End If
        .Text = v
    End With
End Sub
voilà jusqu'a la prochaine coquille ce qui ne manquera pas d'arriver avec l'event change
 

patricktoulon

XLDnaute Barbatruc
re
par exemple ici dans cette version facon patosh
j'arrive a insérer un chiffre mais le selstart par au bout du textbox
je suis donc obligé de recliquer a l'endroit si je veux insérer un nouveau chiffre
VB:
Private Sub TextBox1_Change()
    Dim v$, Dec
    With TextBox1
        v = Replace(Replace(.Text, ".", ","), " ", ""): If v = "" Then Exit Sub
        If v = "," Then v = "0,"
        If InStr(v, ",") = 0 Then
            v = Trim(Format(v, Application.Rept("### ", 10)))
        Else
            If InStr(1, v, ",") > 0 Then
                If v Like "*,*," Then v = Left(v, Len(v) - 1)
                Dec = Mid(v, InStr(1, v, ","))
                v = Trim(Format(Int(v), Application.Rept("### ", 10))) & Dec
                If Left(Right(v, 4), 1) = "," Then v = Left(v, Len(v) - 1)
            End If
        End If
        .Text = v
    End With
End Sub
;)
 

Eric C

XLDnaute Barbatruc
Re le forum
Re le fil

@patrick : trop perfectionniste - Les users n'ont qu'à faire attention lors de leur saisie... Sinon on les appelle des assistés.. et il faut leur mettre un responsable derrière leur c.l lors de chacune des saisies qu'ils effectuent !!!!

Merci encore aux ténors de notre forum

Eric c
 

patricktoulon

XLDnaute Barbatruc
re
oui c'est un peu vrai
je fait ça aussi pour l'experience
et apprendre a maitriser les event activX
je le répète pour ce genre de travail il n'y a pas mieux que l'event keydown
keydown par qu'il gère les touches fonction (enter back,tabulation ,etc..)
sinon pour juste les caractères l'event keypress le fait aussi

je crois que j'ai tout fait avec ça
telephone, secu,iban,(date (les 3 formats)) sufixe ,prefixe etc etc.
le tout avec en plus pour certains le mask de saisie
c'est rigolo

je crois que j'ai perdu @catodique là 🤣
 

Statistiques des forums

Discussions
312 209
Messages
2 086 275
Membres
103 170
dernier inscrit
HASSEN@45