Saisir une date ou un nombre dans un userform

Bonjour,

On voit fleurir régulièrement ce problème de saisie d'une date ou d'un nombre dans un userform au moyen du TextBox.

https://forum.excel-pratique.com/excel/nombre-avec-virgule-non-reconnu-dans-excel-147904

https://forum.excel-pratique.com/excel/userform-decimaux-ne-fonctionnent-pas-121209

Tout simplement parce que un TextBox c'est du texte, et au contraire des feuilles, microsoft n'y a pas implémenté la notion de nombre ou de date !

J'ai donc repris la proposition que j'avais faite (https://forum.excel-pratique.com/excel/nombre-avec-virgule-non-reconnu-dans-excel-147904#p911298) et je l'ai quelque peu amendée.

Attention, j'ai renommé pompeusement ces zones de saisie en NumBox1 et DateBox1 mais ce ne sont que des titres données à ces zones, ce n'est pas le titre qui résout l problème mais les macros associées.

edit : version v2 plus bas

Salut Steelson,

Bravo pour cette application !

Pour la gestion des dates dans les TextBox, j'avais déjà fait un petit code :

https://forum.excel-pratique.com/astuces/gestion-des-dates-dans-des-textbox-147509

Il est un peu plus long que le tiens, mais gère mieux la supression des caractères.

Je pense que je peux adapter le mien en fonction du tiens, je peux faire plus court !

Bonne journée,

Baboutz

Le but est le même, la philosophie un peu différente peut-être : je n'autorise que 2 /, je mets aussi les / quand il le faut et je restreins parfois les chiffres tapés immédiatement dans le code de frappe avec ceci :

    If InStr("0123456789/", Chr(KeyAscii)) = 0 Then KeyAscii = 0
    If UBound(Split(DateBox1, "/")) > 1 And KeyAscii = Asc("/") Then KeyAscii = 0
    If Len(DateBox1) = 0 And InStr("0123", Chr(KeyAscii)) = 0 Then KeyAscii = 0
    If Len(DateBox1) = 3 And InStr("012", Chr(KeyAscii)) = 0 Then KeyAscii = 0

Baboutz

https://forum.excel-pratique.com/astuces/gestion-des-dates-dans-des-textbox-147509

Il est un peu plus long que le tiens, mais gère mieux la supression des caractères.

A te relire, en effet la gestion de la suppression est mieux faite !

Bien pour KeyUp !

Nouvelle version après coopération avec Baboutz https://forum.excel-pratique.com/astuces/gestion-des-dates-dans-des-textbox-147509 qui a eu de très bonnes idées sur les dates :

edit : correction apportée

Dernier petit problème Steelson, ton code m'indique que le mois n'est pas valide alors que je ne l'ai pas encore tapé, on le corrige comme cela :

If Left(tbl(1), 2) > 12 And Not Left(tbl(1), 2) = "" Then MsgBox "Mois non valide !": Exit Sub

Pourquoi pas, merci, mais je n'ai pas réussi à reproduire l'erreur ! Quelle manip as-tu faite ?

Ah ! Étrange...
J'ai :

- Téléchargé ton fichier
- Activé les macros
- Cliqué sur le bouton 'Saisie Date'
- Tapé la date '12/12/2012'

Voici le résultat :

date steelson erreur

À noter que je suis sur mon pc perso et que je suis donc sous office 365, version 2010.

EDIT : Je viens de tester la saisie nombre, ça marche du tonnerre, merci !

J'ai déjà remarqué des écarts de fonctionnement entre les différentes versions d'excel avec des userform et les événements comme AfterUpdate, Exit, Change, c'est le vrai souk chez microsoft ! Je suis en excel 2013 et chez moi je n'ai pas de problème. C'est lié à la synchronisation entre les événements keyup, keydown, change et le moment où l textbox digère la nouvelle donnée introduite.

Par exemple, pour les nombres la solution proposée par Xmenpl https://forum.excel-pratique.com/excel/nombre-avec-virgule-non-reconnu-dans-excel-147904#p911082 ne fonctionne pas chez moi en XL2013, et ne fonctionne pas non plus sur des versions antérieures XL2003, pftt.

Donc bien évidemment j'adopte ta proposition

Et bien, en effet c'est le bazar chez Microsoft !

Super, je crois qu'on touche à la fin, c'est top ! Merci à toi pour l'assemblage de nos codes et l'amélioration de ceux-ci !

Bonne soirée Steelson,

Baboutz

bonjour a tous les deux

vous n'y êtes pas du tout c'est bien plus complexe que ça n'y parait

taper avec contrainte une suite de caractères (date,nombre,voir même code alpha) c'est facile mais vous n’êtes pas protégés de la bévue

pour contraindre un texte box a un seul format (ou plusieurs d'ailleurs) il faut prendre en compte bien plus que l'avancé

il faut contrôler le selstart voir si on est pas au milieu d'une chaîne déjà tapé sans ça vos trois ligne code n'ont plus leur effet

il faut aussi contrôler le sellength ; en effet la touche tape 1 caractère si le sellength est plus grand que 1 là aussi vous êtes chocolat

si formatage avec caractères particulier controler la position au rédigé mais aussi a la re rédaction

c'est pas pour vous décourager mais vous pouvez me croire j'ai bossé dessus copieux

vous trouverez certainement avec mon pseudo des ressources que j'ai rédigé sur les deux forum grand frère

ou demandez

datebox avec ou sans masque de saisie

téléphone

N°secu

riban

Alpha numérique

préfixe et/ou suffixe de chaîne

la monnaie aussi

etc....

Bonjour

il faut contrôler le selstart voir si on est pas au milieu d'une chaîne déjà tapé sans ça vos trois ligne code n'ont plus leur effet

sans avoir un code aussi travaillé que le tien, ce point était quand même pris en compte

Salut patricktoulon,

Personnellement je serai curieux de voir ton fichier de DatesBox qui gère seulement le format fr et us comme tu l'as proposé sur l'autre fil !

Merci

Baboutz

EDIT : Je n'ai pas réussi à trouver toutes les ressources que tu mentionnes ci-dessus

bonjour Baboutz

oui pas de soucis

'****************************************
'textbox date controlée version FR,US
'patricktoulon
'version 12/06/2014
'mise a jour
'date 11/05/2020
' condensation du code
'basé sur le mid(texte,1,5)+année permutée ce qui permet de faire moins de tests
'remise en place du pavé numerique haut du clavier
''date 14/05/2020
'remise en place de US/FR simplifié

'******************************************
Option Explicit

Dim cancL As Boolean

Private Sub TextBox1_Exit(ByVal Cancel As MSForms.ReturnBoolean)
    Cancel = InStr(TextBox1.Value, "_") > 0
End Sub

Private Sub TextBox1_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
    control_saisieX TextBox1, KeyCode, region:=1
End Sub

Private Sub TextBox2_Exit(ByVal Cancel As MSForms.ReturnBoolean)
    Cancel = InStr(TextBox2.Value, "_") > 0
End Sub

Private Sub TextBox2_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
    control_saisieX TextBox2, KeyCode, region:=0
End Sub

Sub control_saisieX(txt As Object, KeyCode, Optional Mask As String = "__/__/____", Optional region As Long = 1)
'MsgBox KeyCode
    Dim Pos&, T$, X&, XL&, xp&, an, XLL&, Max1&, Max2, separateur, charMask$
    separateur = Mid(Mask, 3, 1):    charMask = Left(Mask, 1)
    Max1 = IIf(region = 1, 31, 12): Max2 = IIf(region = 0, 31, 12)
    If KeyCode >= 48 And KeyCode <= 57 Then KeyCode = KeyCode + 48 'conversion du keycode du pavé haut du clavier
    With txt
         XL = .SelLength: If XL = 0 Then XL = 1
        If .Value = "" Then .Value = Mask
        T = .Value: .SelStart = IIf(T = Mask, 0, .SelStart): X = .SelStart
        'Me.Caption = XL 'Application.Max(1, .SelLength)
          Select Case KeyCode
        Case 96 To 105  'pavé numerique
            Select Case X
            Case 0 To 1, 3 To 4, 6 To 9    'en fonction du selstart
                Mid$(T, X + 1, XL) = Chr(KeyCode - 48) & Mid$(Mask, X + 2, XL): X = X + 1    'placement du caractere

                'controle date condensé
                If Val(T) > Max1 Or Mid(T, 1, 2) = "00" Then Mid$(T, 1, 2) = Mid$(Mask, 1, 2): X = 0: XLL = 2: Beep     'max 31 pour jour
                If Val(Mid(T, 4, 2)) > Max2 Or Mid(T, 4, 2) = "00" Then Mid$(T, 4, 2) = Mid$(Mask, 4, 2): X = 3: XLL = 2: Beep     ' max 12 pour le mois
                If X > 5 Then xp = 7 Else If X < 4 Then xp = 1 Else xp = 4    'calcul position pour replace by mask
                If IsNumeric(Mid(T, 7, 4)) And X > 5 Then an = Mid(T, 7, 4): XL = 5 Else an = "2000": XL = 2    'année permuté
                If IsDate(Mid(T, 1, 5)) Then If Not IsDate(Mid(T, 1, 5) & separateur & an) Then Mid(T, xp, XL) = Mid(Mask, xp, XL): Beep: X = InStr(1, T, charMask) - 1: XLL = XL
                If Mid(T, 7, 4) = "0000" Then Mid$(T, 7, 4) = Mid$(Mask, 7, 4): X = 6: XLL = 4: Beep

                .Value = T: .SelStart = IIf(Mid(Mask, X + 1, 1) = separateur, X + 1, X): If XLL > 0 Then .SelLength = XLL    'mise a jour textbox et positionement carret
            Case Else: .SelStart = X + 1: KeyCode = 0
            End Select

        Case 8: If X > 0 Then Mid(T, X, 1) = Mid(Mask, X, 1): .Value = T: .SelStart = X - 1    'touche back
        Case 46: Mid(T, X + 1, XL) = Mid(Mask, X + 1, XL): .Value = T: .SelStart = X: .SelStart = IIf(Mid(T, X + 1, 1) = "/", X + 1, X) 'touche "suppr"
        Case 37: .SelStart = Application.Max(.SelStart - 1, 0)    'fleche gauche
        Case 39: .SelStart = IIf(IsNumeric(Mid(T, .SelStart + 1, 1)) Or Mid(T, .SelStart + 1, 1) = "/", Application.Min(.SelStart + 1, Len(T)), .SelStart) 'fleche droite

        Case Else: KeyCode = 0    'aucune autre touche autorisée
        End Select
        .Value = IIf(T = Mask, "", T)
           .BackColor = Array(RGB(255, 150, 150), vbWhite)(Abs(XLL < 1)) 'si erreur backcolor

End With
    KeyCode = 0:
End Sub

bien sur on gère toujours les touches back,suppr,gauche,droite

sur celui ci on peut pas arranger le masque a sa guise il est en dur "__/__/____"

des qu'une erreur est détecté, le segment est remplacé par son homonyme du masque et sélectionné et il y a le beep et le textbox devient rouge

demo6

voila

enjoy

et si tu veux voir la puissance de ma méthode voici une démo qui définitivement va t'asseoir notamment le dernier exemple contenant des parties fixes

demo6

et si tu veux une version ultra simplicime toujours sur la base de la valeur anticipé(interception du keyascii et du selstart )

en voici une toute mimine

Private Sub TextBox1_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
    char = Chr(KeyAscii)
    With TextBox1
        .MaxLength = 10
        If .SelStart = 2 Then .SelStart = 3
        If .SelStart = 5 Then .SelStart = 6
        .SelLength = 1
        If Len(.Value) = 2 Or Len(.Value) = 5 Then .Value = .Value & "/"
        d = Mid(.Value & char, 1, 2): d = IIf(Val(d) = 0, 1, "0" & d)
        m = Mid(.Value & char, 4, 2): m = IIf(Val(m) = 0, 12, "0" & m)
        y = Mid(.Value & char, 7, 4): y = IIf(Len(y) < 4, 2000, y)
        If Not IsDate(d & "/" & m & "/2000") Then .Value = Left(.Value, 3): KeyAscii = 0:
        If Not IsDate(d & "/" & m & "/" & y) Then KeyAscii = 0: .Value = Left(.Value, Len(.Value) - IIf(y = 2000, 1, 3))
    End With
End Sub

j’arrête là car j'en ai des tas

comme je vous l'ai dis j'ai bossé copieux dessus

allez une dernière pour la route (autre methode)

essaie donc de supprimer"€"

Private Sub TextBox1_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
    With TextBox1
        X = Replace(.Value, " €", "")
        Select Case KeyCode
        Case 96 To 105
            If X <> "" Then If Len(Replace(X, Val(Int(X)), "")) >= 3 Then KeyCode = 0: Exit Sub
            X = X & Chr(KeyCode + IIf(KeyCode < 96, 32, -48))
        Case 110, 188: If Not X Like "*,*" Then X = X & ","
        Case 8: X = Left(X, Len(X) - IIf(X <> "", 1, 0))
        Case Else: KeyCode = 0
        End Select
        .Value = X
        If .Value <> "" Then .Value = .Value & " €"
        .SelStart = Len(X)
    End With
    KeyCode = 0
End Sub


et si tu veux une version ultra simplicime toujours sur la base de la valeur anticipé(interception du keyascii et du selstart )

là ok comme je suis adepte du code minimaliste c'est pas mal

mais on rencontre quelques difficultés si en supprimant des valeurs on arrive à quelque chose comme par exemple 1/3/2... , je me demande s'il ne faut pas faire un split sur /

donc en version courte avec les mêmes fonctionnalités, on peut mettre (sauf erreurs de ma / notre part)

Private Sub DateBox1_KeyPress(ByVal KeyCode As MSForms.ReturnInteger)
    If InStr("0123456789", Chr(KeyCode)) = 0 Then KeyCode = 0
End Sub

Private Sub DateBox1_KeyUp(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
    If KeyCode = 8 Or KeyCode = 46 Or KeyCode = 13 Then Exit Sub
    DateBox1.MaxLength = 10
    tbl = Split(DateBox1, "/")
    Select Case UBound(tbl)
        Case Is = 0
            If Len(DateBox1) > 1 Then DateBox1 = Left(DateBox1, 2) & "/"
        Case Is = 1
            If Len(tbl(1)) > 1 Then DateBox1 = tbl(0) & "/" & Left(tbl(1), 2) & "/"
            If tbl(1) <> "" And Left(tbl(1), 2) > 12 Then MsgBox "Mois non valide !": Exit Sub
        Case Is = 2
            DateBox1 = Left(tbl(0), 2) & "/" & Left(tbl(1), 2) & "/" & Left(tbl(2), 4)
            If Left(tbl(1), 2) > 12 Then MsgBox "Mois non valide !": Exit Sub
            If (Len(tbl(2)) = 2 Or Len(tbl(2)) = 4) And Not IsDate(DateBox1) Then MsgBox "Date non valide !"
    End Select
End Sub

Bonjour Steelson, Baboutz, Patricktoulon,

Je vois vos propositions sur les dates. Et vous en propose une que j'avais laissé à un membre du forum en avril 2020.

Voir colonne A à E.

En fait c'est la couleur de fond du TextBox qui validera ou non la date.

93textboxdate.xlsm (45.61 Ko)
Rechercher des sujets similaires à "saisir date nombre userform"