Saisir une date ou un nombre dans un userform

re

bonjour Steelson

Private Sub TextBox1_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
    Dim t$, X&, XX&, A, Dec&
    If Not Chr(KeyAscii) Like "[0-9-,-.]" Then KeyAscii = 0: Exit Sub
    Dec = 2    'nombre de décimales voulues
    With TextBox1
        t = Replace(.Value, ",", ".") & " "
        X = .SelStart: .SelLength = 0
        XX = IIf(X + 1 < Len(t), 1, 2)
        Mid(t, X + 1, 1) = Replace(Chr(KeyAscii), ",", ".")
        t = Replace(t, " ", "")
        t = Replace(t, Split(t, ".")(0), Trim(Format(Split(t, ".")(0), Application.Rept(" @@@", 35))))
        A = Split(t, "."): If UBound(A) > 0 Then t = Replace(t, A(1), Left(A(1), Dec))
        .Value = t: .SelStart = X + XX
    End With
    KeyAscii = 0
End Sub

si tu veux pouvoir revenir en arrière ou supprimer il te faudra gérer CA dans le keydown et donc convertir le keydown en keyascii

exactement comme je le fait dans mes deux fonction datebox

en attendant avec celui ci tu a le formatage x chiffre après le point piloté par "Dec" et tu a la possibilité de revenir et de modifier un chiffre ou l'insérer

Bonjour patricktoulon,

Merci pour ce code. C'est presque ça en effet, mais le retour en arrière sur la partie entière entraîne que les groupes de 3 chiffres ne sont plus respectés. L'insertion écrase aussi le chiffre d'après selon sa position dans le groupe de 3 et le point se trouve parfois effacé. C'est effectivement là la difficulté de l'exercice

Cette version me permet de

• bien gérer l'insertion de chiffres
• et ne pas écraser le signe de décimales (ici ,),

mais j'ai le problème de l'effacement d'un chiffre

Dim flag As Boolean

Private Sub NumBox1_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
    If KeyAscii = 8 Then KeyAscii = 0: Debug.Print "supp"
    If InStr("0123456789.,", Chr(KeyAscii)) = 0 Then KeyAscii = 0
    If KeyAscii = Asc(".") Then KeyAscii = Asc(",")
    If InStr(NumBox1, ",") > 0 And KeyAscii = Asc(",") Then KeyAscii = 0
    flag = True
End Sub

Private Sub NumBox1_Change()
If Not flag Then Exit Sub
    Application.EnableEvents = False
        x = NumBox1: y = NumBox1.SelStart
        n0 = 0
        For i = 1 To y
            If Mid(x, i, 1) = " " Then n0 = n0 + 1
        Next
        virgule = InStr(x, ",") > 0
        tbl = Split(x, ",")
        entier = Replace(tbl(0), " ", "")
        x = ""
        For i = Len(entier) To 1 Step -1
            x = Mid(entier, i, 1) & x
            If ((Len(entier) - i + 1) Mod 3 = 0) Then x = " " & x
        Next
        x = IIf(Left(x, 1) = " ", Mid(x, 2, Len(x) - 1), x)
        If virgule Then x = x & "," & Left(tbl(1), Application.Min(Len(tbl(1)), 2))
        n1 = 0
        For i = 1 To y
            If Mid(x, i, 1) = " " Then n1 = n1 + 1
        Next
        NumBox1.Value = x
        NumBox1.SelStart = y + n1 - n0
        flag = False
    Application.EnableEvents = True
End Sub

j'ai testé ça l'air fonctionnel

le résultat est un peu troublant au départ sur sellength 3 ou 2 mais on s'y fait

je n'ai pas réussi à tout mettre sous keypress, donc j'attends une première fois la mise à jour pour triturer le nombre

si tu as une solution maintenant en cas de suppression d'un chiffre, je suis preneur, je n'ai pas encore réfléchi à la question !

Ouf ! avec la fonction suppression de chiffre

A nouveau, si qqun arrive à casser le code, je suis preneur, cela veut dire qu'il y a (encore) un potentiel d'amélioration.

edit : version corrigée

Salut à tous,

Steelson, petit problème pour la suppression de chiffres quand on efface la dernier chiffre :

Voir version commentée plus bas.

Bonsoir !

Bravo ! Que ce soit sur le loto ou là dessus vos neurones fonctionnent !
A mon goût, pour comprendre ce qui se passe, je trouve qu'il manque de commentaire votre fichier... Mais bon à moi de me creuser la tête pour suivre la réflexion de ce code.

@ bientôt

LouReeD

Merci LouReeD

LouReeD a écrit :

A mon goût, pour comprendre ce qui se passe, je trouve qu'il manque de commentaire votre fichier...

je suis d'accord, mais même moi parfois je ne comprends pas tout ce que j'écris. Par exemple, ceci était au "pif" NumBox1.SelStart = y + n1 - n0 et ça a marché !

bon je vais faire l'effort !

Décidément...... C'est à rien n'y comprendre... C'est peut-être pour cela que je n'ai pas pris la branche "Moteur"...

@ bientôt

LouReeD

Un peu de littérature alors ...

Dim flag As Boolean, ancien As String

Private Sub NumBox1_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)

    ' seuls caractères autorisés :
        If InStr("0123456789.,", Chr(KeyAscii)) = 0 Then KeyAscii = 0

    ' si point transformation en virgule
        If KeyAscii = Asc(".") Then KeyAscii = Asc(",")

    ' pas 2 fois le signe de séparation entier/décimales
        If InStr(NumBox1, ",") > 0 And KeyAscii = Asc(",") Then KeyAscii = 0

    ' on autorise le traitement de la modif
        flag = True

End Sub

Private Sub NumBox1_Change()
' on traite aussi quand il y a eu effacement, c-a-d que la valeur n'est plus la même que celle entrée auparavant (sauf si effecament complet)
If NumBox1.Value <> ancien And NumBox1.Value <> "" Then flag = True
If Not flag Then Exit Sub

    ' nombre et position du curseur
        x = NumBox1: y = NumBox1.SelStart

    ' décompte du nombre d'espace (10^3x) jusque curseur
        n0 = 0
        For i = 1 To y
            If Mid(x, i, 1) = " " Then n0 = n0 + 1
        Next

    ' test présence de la virgule pour la reproduire
        flag = virgule
        If InStr(x, ",") > 0 Then virgule = True

    ' traitement de l'entier, ajout des espaces pour les 10^3x
        tbl = Split(x, ",")
        entier = Replace(tbl(0), " ", "")
        x = ""
        For i = Len(entier) To 1 Step -1
            x = Mid(entier, i, 1) & x
            If ((Len(entier) - i + 1) Mod 3 = 0) Then x = " " & x
        Next
        ' effacement d'un espace inutile au début de la chaine
        If x <> "" Then x = IIf(Left(x, 1) = " ", Mid(x, 2, Len(x) - 1), x)

    ' remise de la virgule
        If virgule Then x = x & "," & Left(tbl(1), Application.Min(Len(tbl(1)), 2))

    ' nouveau décompte du nombre d'espace (10^3x) jusque curseur
        n1 = 0
        For i = 1 To y
            If Mid(x, i, 1) = " " Then n1 = n1 + 1
        Next

    ' le "final" pour sauvegarder la nouvelle valeur, l'afficher dans la box, et positionner le curseur
        ancien = x
        NumBox1.Value = x
        NumBox1.SelStart = y + n1 - n0

    ' on interdit une seconde itération
        flag = False

End Sub

Private Sub CommandButton1_Click()
    Range("B2") = CDbl(NumBox1.Value)
    Me.Hide
End Sub

Steelson,

Désolé je suis un peu le mec relou qui te présente toujours un bogue, mais je viens d'en trouver un nouveau
J'écris un nombre, puis je décale mon curseur afin de supprimer un caractère, je clique sur "Suppr", cela supprime bien le chiffre mais ajoute une virgule à la place !
En revanche, si je sélectionne plusieurs chiffres au milieu du nombre et que je "Suppr" -> Pas de soucis

Et question, Steelson, dans ton code, où est-il possible de contrôler le nombre de chiffre après la virgule ?

Baboutz a écrit :

Et question, Steelson, dans ton code, où est-il possible de contrôler le nombre de chiffre après la virgule ?

ici

If virgule Then x = x & "," & Left(tbl(1), Application.Min(Len(tbl(1)), 2))

Baboutz

Baboutz a écrit :

Désolé je suis un peu le mec relou qui te présente toujours un bogue, mais je viens d'en trouver un nouveau

J'écris un nombre, puis je décale mon curseur afin de supprimer un caractère, je clique sur "Suppr", cela supprime bien le chiffre mais ajoute une virgule à la place !

peux-tu essayer avec la dernière version commentée, en la commentant je m'étais aperçu du ligne en trop et je pense que le bug vient de là.

Voici la version "commentée"

Cela marche parfaitement chez moi

J'ai juste trouvé un bogue Microsoft je crois mais on ne peux rien y faire. (En appuyant sur F11, insère des carrés dans la TextBox)

Bravo Steelson, superbe petite appli !

bonsoir tous les deux

il faudra quand même m'expliquer l'utilisation de selstart dans un Evénement change

Patrick,

c'est juste pour le remettre au bon endroit, sinon le selstart se remettait à la fin des décimales et cela devenait difficile de rajouter / modifier au milieu des chiffres.

Michel

Bonjour steelson

Je réponds de ma tablette car panne d écran

selstart c'est la position du carret(la petite barre qui clignote) et dans l event change elle est toujours a la fin car on est posteriori la touche tapée

tu mettrais len(.value ça serait pareil)

si tu me dis que selstart te donne juste la position de l entier c est faux c est pas possible ou alors il y a un gros blême dans le potage

j etudirais ça demain avec un écran qui marche

non, je n'ai jamais écrit cela !

patricktoulon a écrit :

si tu me dis que selstart te donne juste la position de l entier c est faux c est pas possible ou alors il y a un gros blême dans le potage

par contre, oui, j'ai été surpris de pouvoir la capter au début du textbox.change, sinon je l'aurais capté au moment du keypress