Discussion :

[mosar3]

Bonjour à tous,

Je cherche un moyen d'anticiper une erreur de saisie de date par un utilisateur sur un userform afin d'éviter un plantage du userform ; en effet une formuler utilise cette date comme suit :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
 
Private Sub TextBox2_AfterUpdate()
    Dim dttoday As Date
    dttoday = Date
        If TextBox2.Value = "" Then
        LabelDateDeNaissance.Caption = "Date de naissance"
        Else: LabelDateDeNaissance.Caption = Application.WorksheetFunction.RoundDown(Application.WorksheetFunction.YearFrac(TextBox2.Value, dttoday), 1)&" ans"
End If
End Sub

En l'état actuel dès que l'utilisateur enregistre mal la date (faute de frappe ou date trop ancienne) le code plante... L'idéal serait que le caption concerné puisse devenir "ATTENTION la date rentrée n'est pas valide" pour que l'utilisateur remarque son erreur et la corrige mais sans que cela plante le code

Merci beaucoup de vos conseils !
ps: soyez indulgents je reprend à peine le vba pour un nouveau projet et j'ai l'impression de repartir de zero
ps2: j'ai bidouillé une astuce pour calcul de date mais ça me semble bien sale comme code, si quelqu'un à sous la main quelque chose de carré ce sera sans doute mieux

[Jean-Philippe André]

Salut,

la fonction IsDate() retrourne un booléenne t'indiquant si oui ou non la valeur passée en paramètre est considérée comme une date.

[mosar3]

Salut,

la fonction IsDate() retrourne un booléenne t'indiquant si oui ou non la valeur passée en paramètre est considérée comme une date.

Salut,

J'ai cru que c'était bon mais la fonction IsDate semble accepter plus d'éléments que YearFrac ; si un utilisateur rentre une date comme "10 janvier 1993" ou "10.01.93" le code suivant plante avec "impossibilité de lire la propriété Yearfrac de la classe worksheetfunction".

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
 
Private Sub TextBox2_AfterUpdate()
    Dim dttoday As Date
    Dim VerifDate
    dttoday = Date
    VerifDate = IsDate(TextBox2.Value)
        If TextBox2.Value = "" Then
        LabelDateDeNaissance.Caption = "Date de naissance"
        ElseIf VerifDate = True Then LabelDateDeNaissance.Caption = Application.WorksheetFunction.RoundDown(Application.WorksheetFunction.YearFrac(TextBox2.Value, dttoday), 1) & " ans"
        Else: LabelDateDeNaissance.Caption = "Attention date non valide !"
        End If
End Sub

[Jean-Philippe André]

Si le IsDate retourne vrai, tu peux faire alors un CDate() de ta valeur, pour voir ce qu'elle contient vraiment, et utiliser une variable de type date pour ton cas.

[hyperion13]

Salut
Pourquoi ne pas vérifier au moment de la frappe dans Textbox2 ?

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
Private Sub TextBox2_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
Select Case KeyAscii
    Case Asc("0") To Asc("9")
    Case Else: KeyAscii = 0
End Select
If Len(TextBox2) = 2 Or Len(TextBox2) = 5 Then TextBox2.Value = TextBox2.Value & "/"
End Sub

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
Private Sub TextBox2_BeforeUpdate(ByVal Cancel As MSForms.ReturnBoolean)
If IsDate(Me.TextBox2.Text) Then
    Me.TextBox2.Text = Format(Me.TextBox2.Text, "dd/mm/yyyy")
    Me.Label2.Caption = DateDiff("yyyy", TextBox2.Text, Date) & " ans"
Else
    Me.Label2.Caption = "Attention date non valide !"
    Me.TextBox2.Value = ""
    Cancel = True
End If
End Sub

[mosar3]

Salut Hyperion,

Merci beaucoup pour ta proposition qui est très pratique,et permet même une saisie plus rapide ; pas besoin de mettre les slashs sur la date cela se met tout seul!
Je pense que c'est parfait ainsi... même si j'ai du mal à comprendre le fonctionnement de la première procédure

[hyperion13]

re
le 1er code permet de ne saisir que des valeurs numériques de 0 à 9.

[mosar3]

Par contre comme il calcule la différence d'année il pouvait y avoir jusqu'à 11 mois d'écart avec la date réelle, j'ai donc modifié le code comme suit :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
 
Private Sub TextBox2_BeforeUpdate(ByVal Cancel As MSForms.ReturnBoolean)
    Dim nbmois
    Dim AgeAn
    Dim AgeMois
 
If IsDate(Me.TextBox2.Text) Then
    nbmois = DateDiff("m", TextBox2.Text, Date)
    Me.TextBox2.Text = Format(Me.TextBox2.Text, "dd/mm/yyyy")
    AgeAn = Application.WorksheetFunction.Quotient(nbmois, 12)
    AgeMois = nbmois Mod 12
 
 
    Me.LabelDateDeNaissance.Caption = AgeAn & " ans et " & AgeMois & " mois"
Else
    Me.LabelDateDeNaissance.Caption = "Attention date non valide !"
    Me.TextBox2.Value = ""
    Cancel = True
End If

Je crois que comme ça il ne peut plus y avoir que quelques jours d'écart ce qui pose moins de problème !
Merci beaucoup en tout cas ;-)

[hyperion13]

re
Sauf qu'à aucun moment, Post#1 et suivants, vous indiquez que vous voulez calculer l'âge du cheval en Année + Mois + Jours

[mosar3]

Tout à fait tout à fait ce n'était pas un reproche loin de là. D'ailleurs en jours cela me paraîtrait trop précis inutilement.
J'étais juste content de réussir à adapter votre code à ce qui semble mieux pour mon usage mais effectivement chaque usage est potentiellement différent donc vous ne pouviez pas savoir avant et c'est bien normal
Encore merci pour votre aide