Gestion des dates dans des TextBox

Le 15/10/2020 à 20:31

Bonjour à tous !

Qui n'a jamais été embêté par la gestion des dates dans des TextBox ... ?

Personne en effet !

La fonction IsDate() n'est pas assez complète pour une date au format Français. Effectivement, si on vérifie la date '12/13/2020' elle nous renvoie Vrai alors que c'est faux !

Je vous partage donc les petits bouts de codes que j'ai mis au point pour gérer ces dates et faciliter la saisie de l'utilisateur.

Cela se fait en trois procédures :

1/

Private Sub TextBox_Date_Change()

    'On autorise la saisie de 10 caractères maximum
    TextBox_Date.MaxLength = 10

End Sub

2/

Private Sub TextBox_Date_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)

    'On autorise uniquement la saisie des caractères "0123456789"
    If InStr("0123456789", Chr(KeyAscii)) = 0 Then KeyAscii = 0

End Sub

3/

Private Sub TextBox_Date_KeyUp(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)

Dim Valeur As Byte

    'Si l'utilisateur presse la touche "Suppr" ou la touche "Del" (<-) alors quitte la procédure
    If KeyCode = 8 Or KeyCode = 46 Then

        Exit Sub

    Else

        Valeur = Len(TextBox_Date)

        'Si le jour ou le mois est inscrit, alors ajoute un "/" automatiquement
        If Valeur = 2 Then
            TextBox_Date = TextBox_Date & "/"
        ElseIf Valeur = 5 Then
            TextBox_Date = TextBox_Date & "/20"
        End If

        'Si la date inscrite contient 10 caractères
        If Valeur = 10 Then

            'Si le jour est compris entre [1;31] et le mois entre [1;12] alors
            If (Mid(TextBox_Date.Value, 1, 2) >= 1 And Mid(TextBox_Date.Value, 1, 2) < 32) And (Mid(TextBox_Date.Value, 4, 2) >= 1 And Mid(TextBox_Date.Value, 4, 2) < 13) Then

                'On va étudier les cas des différents mois
                Select Case Mid(TextBox_Date.Value, 4, 2)

                    'Pour les mois d'Avril, Juin, Octobre et Novembre
                    Case 4, 6, 9, 11

                        'Si le jour est supérieur à 30 alors va à DateNonExistante
                        If Mid(TextBox_Date.Value, 1, 2) > 30 Then
                            GoTo DateNonExistante
                        End If

                    'Pour le mois de Février
                    Case 2

                        On Error GoTo DateNonExistante 'Permet de gérer les années non bissextiles inférieures à l'année 2000

                        'Si l'année n'est pas bissextile mais que le jour rentré est 29 alors va à DateNonExistante
                        If Not Day(DateSerial(Year(TextBox_Date.Value), 3, 1 - 1)) = 29 And Mid(TextBox_Date.Value, 1, 2) = 29 Then
                            GoTo DateNonExistante
                        End If

                End Select

            Else

DateNonExistante:
                MsgBox "Veuillez entrer une date valide."
                TextBox_Date.Value = ""

            End If

        End If

    End If

End Sub

Je vous joins également un fichier pour vous montrer. Après, libre à vous de modifier le code à votre guise en fonction de vos préférences !

376gestiondateusf.xlsm (19.60 Ko)

En espérant vous avoir aidé !

Baboutz

Le 22/10/2020 à 20:36

Bonjour toutes et tous

merci @toi ^^

crdlt,

André

Le 22/10/2020 à 21:01

Avec plaisir André !

Le 08/11/2020 à 16:50

Très intéressant, je n'avais pas vu passer cet outil fort utile !

Je n'avais jamais réussi de mon côté à utiliser KeyUp ! bien vu ...

Le 08/11/2020 à 17:22

On pourrait résumer ton code comme ceci ...

Private Sub TextBox_Date_Change()
    'On autorise la saisie de 10 caractères maximum
    TextBox_Date.MaxLength = 10
    If Len(TextBox_Date) = 10 Then
        If Not IsDate(TextBox_Date) Then
            MsgBox "Date non valide !"
        End If
    End If
End Sub

Private Sub TextBox_Date_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
    'On autorise uniquement la saisie des caractères "0123456789"
    If InStr("0123456789", Chr(KeyAscii)) = 0 Then KeyAscii = 0
End Sub

Private Sub TextBox_Date_KeyUp(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
    'Si l'utilisateur presse la touche "Suppr" ou la touche "Del" (<-) alors on quitte la procédure
    If KeyCode = 8 Or KeyCode = 46 Then Exit Sub
    Select Case Len(TextBox_Date)
        Case 2
            TextBox_Date = Left(TextBox_Date, 2) & "/"
        Case 5
            TextBox_Date = Left(TextBox_Date, 5) & "/20"
    End Select
End Sub

il subsiste juste une anomalie après suppression d'un caractère du mois et d'un caractère du jour que l'on pourrait accessoirement traiter , mais elle de toute façon bloquée par

TextBox_Date_Change()
capture d ecran 240

et puis il faut avoir l'esprit tordu comme le mien pour faire cela !

Le 08/11/2020 à 18:17

Merci beaucoup Steelson !

En effet ton code est bien plus concis, c'est top ... Hormis l'anomalie que tu as décrite, le seul "hic" maintenant est que si l'utilisateur rentre la date "12/13/2020" cela ne détecte pas que la date est erronée.
Mais avec une légère modification, le tour est joué :

Private Sub TextBox_Date_Change()
    'On autorise la saisie de 10 caractères maximum
    TextBox_Date.MaxLength = 10
    If Len(TextBox_Date) = 10 Then
        If Not IsDate(TextBox_Date) Or Mid(TextBox_Date.Value, 4, 2) > 12 Then
            MsgBox "Date non valide !"
        End If
    End If
End Sub

Private Sub TextBox_Date_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
    'On autorise uniquement la saisie des caractères "0123456789"
    If InStr("0123456789", Chr(KeyAscii)) = 0 Then KeyAscii = 0
End Sub

Private Sub TextBox_Date_KeyUp(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
    'Si l'utilisateur presse la touche "Suppr" ou la touche "Del" (<-) alors on quitte la procédure
    If KeyCode = 8 Or KeyCode = 46 Then Exit Sub
    Select Case Len(TextBox_Date)
        Case 2
            TextBox_Date = Left(TextBox_Date, 2) & "/"
        Case 5
            TextBox_Date = Left(TextBox_Date, 5) & "/20"
    End Select
End Sub

D'ailleurs on peut modifier dans ton code

TextBox_Date = Left(TextBox_Date, 2) & "/"

Par

TextBox_Date = TextBox_Date & "/"

Pour éviter le mini-calcul du Left ahah !

Merci encore !! Je vais mettre mon code à jour.

Le 08/11/2020 à 20:10

Je vais regarder demain, car je suis en train de voir si on ne peut pas remplacer le nombre de chiffres par le nombre de / présents et éviter ces anomalies.

Le 09/11/2020 à 02:52

Autre proposiiton edit : supprimée et remplacée

Le 09/11/2020 à 09:03

Bonjour Steelson,

Plus de présence de l'anomalie mais le code n'accepte plus les dates au format jj/mm/aaaa mais seulement au format jj/mm/aa !
Sinon grand bravo, le code n'a pas l'air si difficile que ça, il faut que je me penche dessus pour bien le comprendre!

Le 09/11/2020 à 09:11

J'ai été un peu trop vite dans une ultime correction mal venue ... bref je suis embourbé, faut que je reprenne, pfttt quand on veut aller trop vite !

Le 09/11/2020 à 09:33

Correction

Private Sub TextBox_Date_KeyPress(ByVal KeyCode As MSForms.ReturnInteger)
    'On autorise uniquement la saisie des caractères "0123456789"
    If InStr("0123456789", Chr(KeyCode)) = 0 Then KeyCode = 0
End Sub

Private Sub TextBox_Date_KeyUp(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
    'Si l'utilisateur presse la touche "Suppr" ou la touche "Del" (<-) alors on quitte la procédure
    If KeyCode = 8 Or KeyCode = 46 Then Exit Sub
    tbl = Split(TextBox_Date, "/")
    Select Case UBound(tbl)
        Case Is = 0
            If Len(TextBox_Date) > 1 Then TextBox_Date = Left(TextBox_Date, 2) & "/"
        Case Is = 1
            If Len(tbl(1)) > 1 Then TextBox_Date = tbl(0) & "/" & Left(tbl(1), 2) & "/20"
        Case Is = 2
            TextBox_Date = Left(tbl(0), 2) & "/" & Left(tbl(1), 2) & "/" & Left(tbl(2), 4)
            If tbl(1) > 12 Then MsgBox "Date non valide !": Exit Sub
            If (Len(tbl(2)) = 2 Or Len(tbl(2)) = 4) And Not IsDate(TextBox_Date) Then MsgBox "Date non valide !"
    End Select
End Sub
Le 09/11/2020 à 10:54

C'est superbe Steelson...

Je rajoute Or KeyCode = 13 qui permet de gérer la MsgBox et donc pouvoir fermer cette dernière via la touche entrée sans en ouvrir une autre !

J'aime aussi le .MaxLength qui permet de bloquer la TextBox donc je le laisserai perso !

Private Sub TextBox_Date_KeyPress(ByVal KeyCode As MSForms.ReturnInteger)
    'On autorise uniquement la saisie des caractères "0123456789"
    If InStr("0123456789", Chr(KeyCode)) = 0 Then KeyCode = 0
End Sub

Private Sub TextBox_Date_KeyUp(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
    'Si l'utilisateur presse la touche "Suppr" ou la touche "Del" (<-) alors on quitte la procédure
    If KeyCode = 8 Or KeyCode = 46 Or KeyCode = 13 Then Exit Sub
    tbl = Split(TextBox_Date, "/")
    Select Case UBound(tbl)
        Case Is = 0
            If Len(TextBox_Date) > 1 Then TextBox_Date = Left(TextBox_Date, 2) & "/"
        Case Is = 1
            If Len(tbl(1)) > 1 Then TextBox_Date = tbl(0) & "/" & Left(tbl(1), 2) & "/20"
        Case Is = 2
            TextBox_Date = Left(tbl(0), 2) & "/" & Left(tbl(1), 2) & "/" & Left(tbl(2), 4)
            If tbl(1) > 12 Then MsgBox "Date non valide !": Exit Sub
            If (Len(tbl(2)) = 2 Or Len(tbl(2)) = 4) And Not IsDate(TextBox_Date) Then MsgBox "Date non valide !"
    End Select
End Sub

Private Sub TextBox_Date_Change()
    'On autorise la saisie de 10 caractères maximum
    TextBox_Date.MaxLength = 10
End Sub
Le 09/11/2020 à 11:19

Dans ce cas, remonte le MaxLength au niveau du KeyUp

Le 10/11/2020 à 18:22

bonjour a tous

je me permet de revenir sur une affirmation fausse

a l'entrée le'auteur pretends ceci

'-------------------------------------------------------

La fonction IsDate() n'est pas assez complète pour une date au format Français.

Effectivement, si on vérifie la date '12/13/2020' elle nous renvoie Vrai alors que c'est faux !

'------------------------------------------------------

ben désolé mais cette affirmation est fausse

c'est bien une date reconnu au format "mm/dd/yyyy"

d'ailleurs ce petit test ci dessous prouve bien que vba fait bien la différence entre le jour et le mois

Sub test2()
MsgBox Day(CDate("12/13/2020"))
MsgBox Day(CDate("13/12/2020"))
End Sub

alors oui en effet le test isdate n'est pas la fonction qu'il faut dans le sens ou l'on attend une date d'un certain format

je vous propose donc une toute petite fonction condensée qui ne laissera passer que le format "dd/mm/yyyy"

Function isdateFR(ByVal dat As Variant) As Boolean
'nous voulons avoir que le format "dd/mm/yyyy" (europe)qui soit validé
If IsDate(dat) Then isdateFR = Format(dat, "dd/mm/yyyy") = dat And Len(dat) = 10
End Function

Sub test()
'ce sont toutes les 3 des dates valides reconnues par les fonctions vba et excel
MsgBox isdateFR("12/13/2020")
MsgBox isdateFR("13/12/2020")
MsgBox isdateFR("13/12/20")
End Sub

ensuite

vous aimez le préformatage des textbox en datebox

et bien joyeux noel

je vous en propose un pour toute la surface du globe et cerise sur le gâteau vous avez un masque de saisie paramétrable a l'appel

'********************************************************************
'           TEXTBOX FORMATE AVEC MASQUE DE SAISIE DYNAMIQUE
'Auteur patricktoulon sur exceldownload
'Version 2019/2020
'utilisation de l'interception du keycode dans le keydown
'les 3 formats de date géré par excel * le nombre de separateurs possible et caractere du masque
'*********************************************************************
Option Explicit
Public Function control_keydown(tdat As Object, KeyCode, Optional mask As String = "dd/mm/yyyy", Optional charMASK As String = "_")
'MsgBox KeyCode
    Dim txt$, X&, plus&, longg&, sep$, mask2$
    'construction du masque de saisie(mask2) en fonction de la chaine de format de date injectée
    mask2 = Replace(Replace(Replace(mask, "d", charMASK), "m", charMASK), "y", charMASK)
    sep = Left(Replace(mask2, charMASK, ""), 1) 'determine le caractere de separation
    If tdat = "" Then tdat = mask2    'si textbox vide alors = mask2
    txt = tdat.Value: If txt = mask2 Then tdat.SelStart = 0: tdat = ""
    X = tdat.SelStart: longg = tdat.SelLength: If longg = 0 Then longg = 1
    If KeyCode = 8 And longg > 1 Then KeyCode = 46
    Select Case KeyCode
    Case 96 To 105
        If X = 10 Then KeyCode = 0: Exit Function
        If Mid(mask2, X + 1, 1) = sep Then X = X + 1
        Mid(txt, X + 1, longg) = Mid(mask2, X + 1, longg): tdat = txt: plus = IIf(KeyCode < 96, 32, -48):    'reformate si plus de 1 caractere selectionné
        Mid(txt, X + 1, 1) = Chr(KeyCode + plus): tdat = txt: tdat.SelStart = X + 1: KeyCode = 0
        If Mid(tdat, X + 2, 1) = sep Then tdat.SelStart = X + 2
        'control de validité de la date tapée a tout moment
        Dim Pos1&, Pos2&, Part1$, Part2$, Part3$, PosX&
        Select Case True    'determine les segment jours/mois/année  et les positions selstart SELON le format injecté
        Case Left(mask, 2) = "yy": Part2 = Mid(tdat, 6, 2): Part1 = Mid(tdat, 9, 2): Part3 = Mid(tdat, 1, 4): Pos1 = 8: Pos2 = 5: PosX = 8
        Case Left(mask, 2) = "mm": Part2 = Mid(tdat, 1, 2): Part1 = Mid(tdat, 4, 2): Part3 = Mid(tdat, 7, 4): Pos2 = 0: Pos1 = 3: PosX = 3
        Case Left(mask, 2) = "dd": Part1 = Mid(tdat, 1, 2): Part2 = Mid(tdat, 4, 2): Part3 = Mid(tdat, 7, 4): Pos1 = 0: Pos2 = 3: PosX = 3
        End Select
        'on ne peut depasser 31 pour les jours et 12 pour le mois quelque soit le format
        If Val(Part1) > 31 Or Val(Left(Part1, 1)) > 3 Or Part1 = "00" Then tdat.SelStart = Pos1: tdat.SelLength = 2: Beep: Exit Function
        If Val(Part2) > 12 Or Val(Left(Part2, 1)) > 1 Or Part2 = "00" Then tdat.SelStart = Pos2: tdat.SelLength = 2: Beep: Exit Function
        'quand jour et mois sont rempli on teste avec l'annéee 2000(année bissextile pour fevrier)et 30 ou 31 pour les autres mois
        If IsDate(Part1 & "/" & Part2) Then If Not IsDate(Part1 & "/" & Part2 & "/2000") Then tdat.SelStart = PosX: tdat.SelLength = 2: Beep
        If Not IsDate(tdat) And InStr(tdat, charMASK) = 0 Then    'si plus de caracteres mask on teste la date complete
            tdat.SelStart = InStrRev(tdat.Text, sep): tdat.SelLength = 4: Beep: Exit Function
        Else
            'pour pallier a l'erreur de isdate pour les année inferieur a 100 pour fevrier
            If IsDate(tdat) Then If Year(CDate(tdat)) <> Val(Part3) Then tdat.SelStart = InStrRev(tdat.Text, sep): tdat.SelLength = 4: Beep
        End If
    Case 8    'touche BACK (Retour en arrière)
        If X <> 0 Then Mid(txt, X, longg + 1) = Mid(mask2, X, longg + 1)
        tdat = txt: tdat.SelStart = X - 1: KeyCode = 0
        If tdat = mask2 Then tdat = ""
        If Mid(txt, X - IIf(X > 1, 1, 0), 1) = sep Then tdat.SelStart = X - 2
    Case 46 'touche Suppr(supprimer)
    Mid(txt, X + 1, longg) = Mid(mask2, X + 1, longg): KeyCode = 0: tdat = txt: tdat.SelStart = X    'touche Suppr
    Case 37: tdat.SelStart = X - 1    'touche fleche gauche
    Case 39: tdat.SelStart = X + 1    'touche fleche droite
    Case 13 Or 9    ' ce que l'on veux c'est la sortie
    Case Else: KeyCode = 0    'touche les autres touches sont exclues
    End Select

End Function

exemple d'utilisation dans textbox dans un userform

Private Sub TextBox1_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
    control_keydown TextBox1, KeyCode, "yyyy-mm-dd", "_"
End Sub

Private Sub TextBox2_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
    control_keydown TextBox2, KeyCode, "mm/dd/yyyy", "_"
End Sub

Private Sub TextBox3_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
    control_keydown TextBox3, KeyCode, "dd/mm/yyyy", "_"
End Sub

Private Sub TextBox4_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
    control_keydown TextBox4, KeyCode
End Sub
Private Sub TextBox5_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
    control_keydown TextBox5, KeyCode, "dd mm yyyy"
End Sub

Enjoy

130newwboxdate2019-2020-fr-us-ca.xlsm (22.34 Ko)
Le 10/11/2020 à 20:07

Salut patricktoulon et bienvenu sur le forum !

En effet, vba comprend bien quel est le jour et quel est le mois. Ce que je voulais souligner, c'est que ce n'est pas pratique pour vérifier une date au format français, si l'utilisateur se trompe sur le mois C'est vrai que je suis encore un jeunôt sur Excel et VBA, j'ai encore beaucoup à apprendre !

En tout cas un grand merci pour le partage de tes codes, c'est vrai que je n'ai pas l'habitude d'aller voir l'autre gros forum.
Je vais regarder le code d'un petit peu plus près !

En tritouillant 2min, j'ai découvert deux bogues :

  1. J'ai maintenu la touche Del (<-) maintenu pour effacer la date et quand la TextBox était vide cela a créé un problème.
  2. Du coup j'ai essayé avec la touche suppr et même soucis

Un grand merci encore,

Baboutz

Le 10/11/2020 à 20:46

Beau code, mais comment cela fonctionne-t-il ? J'ai lancé l'userform, et je n'arrive pas à taper des chiffres dans aucune des cases. Curieux !

Nota : je n'ai pas de pavé numérique, mais je ne pense pas que ce soit la cause au vu du code.

Le 10/11/2020 à 21:01

bonsoir Steelson

je sais plus si j'ai remis la gestion du pavé haut dans cette version je vais vérifier

OK vérifier c'est pas remis

donc a mettre après les déclarations de variables

 If KeyCode >= 48 And KeyCode <= 57 Then KeyCode = KeyCode + 48 'conversion du keycode du pavé haut du clavier

je vais voir pour les 2 bugs si ca ce passe chez moi

merci du retour

Le 10/11/2020 à 21:14

Baboutz bonsoir

voila le correctif pour la touche del sur selstart 0

Case 8 'touche BACK (Retour en arrière)
If X = 0 Then Exit Function

demo6


j'ai une version simplifiée avec masque de saisi toujours mais uniquement pour le format FR/US si ça vous intéresse

elle est moins verbeuse

Le 10/11/2020 à 21:33

Bonsoir,

patricktoulon a écrit :

donc a mettre après les déclarations de variables

 If KeyCode >= 48 And KeyCode <= 57 Then KeyCode = KeyCode + 48 'conversion du keycode du pavé haut du clavier

merci beaucoup

  1. du coup, j'en apprends beaucoup sur les keycodes
  2. cela me confort dans mon point de vue sur les userform, j'ai toujours privilégié et je continuerai à privilégier l'emploi des feuilles dédiés à la saisie en lieu et place des userform dont microsoft n'a jamais fait profiter des évolutions des feuilles, que ce soit pour les formats date comme pour les formats numériques ! on finit pas faire des macros pour compenser.
Le 10/11/2020 à 21:47

une dernière chose

le principe est (vous l'avez compris ) l'interception du keycode

de ce fait j'ai vu plus haut l'utilisation du keyup

et bien c'est a proscrire car au keyup la touche est entériné ainsi qu'avec l'event change d'ailleurs et c'est plus dificile de revenir et de gerer les selstart pour les modif

l'interception se fait comme suit

exemple avec le keypress et non le keyup!!! un truc tout simple

ici on va interdire de taper n'importe quel mot contenant "av"

Private Sub TextBox1_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
with textbox1
if instr(1,.value & keyascii,"av")>0 then keyascii=0 else t=.value & keyascii

'd'autres éventuels traitement sur t qui contient (la valeur et  la touche) alors que l'on est encore appuyé
'...
'....
.value= t'en dernier
keyascii=0
end with
End Sub

autrement dit on peu tester la valeur du textbox avec la touche comme si elle était entériné et surtout !! keyascii = toujours 0 a la fin

keycode=0 pour l'event keydown

on a alors le vrai selstart valide au moment de la touche pressée au keyup on est après

Rechercher des sujets similaires à "gestion dates textbox"