Intégrer une condition supplémentaire dans mon code de gestion date

Version imprimable

Bonsoir le forum

Je sollicite votre aide pour intégrer une nouvelle condition dans le code ci-dessous:
Code:

1 2 3 4 5 6 7 8 9 10 11 12 Dim Valeur As String TextBox11.MaxLength = 10 'nb caractères maxi autorisé dans le textbox Valeur = Len(TextBox11) If Valeur = 2 Or Valeur = 5 Then TextBox11 = TextBox11 & "." ElseIf Valeur = 10 Then If Not IsDate(Format(Replace(TextBox11, ".", "/"), "yyyy/mm/dd")) Then MsgBox "Format incorrect" TextBox11 = "" Exit Sub End If End If
Dans le textbox11, je saisis la date de naissance de mes clients.
Je souhaite que si la date de naissance saisie est inférieure à 18ans, que le champ soit bloquant pour permettre la correction de la date avant de pouvoir quitter. Le message d'erreur pourra être " Merci de Vérifier la date de naissance saisie".
Merci

Bonjour,

Ceci:

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
Private Sub TextBox11_Change()
    Dim Valeur As String
    TextBox11.MaxLength = 10 'nb caractères maxi autorisé dans le textbox
    Valeur = Len(TextBox11)
    
    If Valeur = 2 Or Valeur = 5 Then
        TextBox11 = TextBox11 & "/"
    ElseIf Valeur = 10 Then
        If Format((Date * 1 - CDate(TextBox11) * 1), "yy") * 1 < 18 Then
            MsgBox "Format incorrect"
            TextBox11 = ""
            Exit Sub
        End If
        If Not IsDate(Format(Replace(TextBox11, ".", "/"), "yyyy/mm/dd")) Then
            MsgBox "Format incorrect"
            TextBox11 = ""
        End If
    End If
End Sub

Cdlt

Vous pouvez adapter ce code à vos besoins:

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
 
Sub testDateNaissance()
On Error GoTo ErrAgent
 
    Dim maDate As Variant       'Cette ligne est inutile si vous remplacez "maDate" par TextBox11 dans ce qui suit :
    Dim inputOK As Boolean: inputOK = False
 
    Do While inputOK = False
        'InputBox est inutile si vous remplacez "maDate" par TextBox11
        maDate = InputBox("Introduisez la date de naissance (format 'jj/mm/aaaa'):", "Date", Int(Now()), 1)
        If maDate = "" _
            Or Val(maDate) = 0 _
            Or Len(maDate) < 10 Then
            MsgBox "Date incorrecte !", vbCritical + vbOKOnly, "Erreur date"
        ElseIf DateDiff("yyyy", DateSerial(Year(maDate), Month(maDate), Day(maDate)), Now()) < 18 Then
            MsgBox "Age inférieur à 18 ans !", vbCritical + vbOKOnly, "Erreur date"
        Else
            inputOK = True
        End If
    Loop
 
    maDate = Format(maDate, "yyyy/mm/dd")
    MsgBox "Le date introduite est : " & Format(maDate, "dd/mm/yyyy")
 
ErrAgent_Exit:
    Exit Sub
 
ErrAgent:
    MsgBox "Le format de la date de naissance est incorrect !", vbCritical + vbOKOnly, "Erreur date"
    Me.TextBox11 = "": Me.TextBox11.SetFocus
    Resume ErrAgent_Exit
 
End Sub

Bonsoir Zakraoui,Arturo83 et le forum

Merci pour vos réponses respectives.
Arturo83 :le blocage ne fonctionne pas dans mon test.
J'ai saisi comme date dans le textbox11 "25/09/2020" mais je suis passé au control suivant sans qu'il y'ait eu de blocage.
Aussi, je constate que la comparaison porte sur l'année, je souhaite si possible qu'on prenne en considération le jour, mois et l'année dans la différence.
Zakraoui : le input ne facilite pas mes tests. il crée des blocages et plante mon fichier car je suis obligé de passer par le gestionnaire de tache pour fermer le fichier car le message d'erreur bloque "tout". Est-ce possible de faire sans input et utiliser le textbox11?
Zakraoui voici ce que j'ai essayé de bricoler mais ca fonctionne pas:
Code:

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 Sub testDateNaissance() 'On Error GoTo ErrAgent Dim maDate As Variant 'Cette ligne est inutile si vous remplacez "maDate" par TextBox11 dans ce qui suit : 'Dim inputOK As Boolean: inputOK = False 'Do While inputOK = False 'InputBox est inutile si vous remplacez "maDate" par TextBox11 'maDate = InputBox("Introduisez la date de naissance (format 'jj/mm/aaaa'):", "Date", Int(Now()), 1) If maDate = "" _ Or Val(maDate) = 0 _ Or Len(maDate) < 10 Then MsgBox "Date incorrecte !" ', vbCritical + vbOKOnly, "Erreur date" ElseIf DateDiff("yyyy", DateSerial(Year(maDate), Month(maDate), Day(maDate)), Now()) < 18 Then MsgBox "Age inférieur à 18 ans !" ', vbCritical + vbOKOnly, "Erreur date" Else 'inputOK = True End If Loop 'maDate = Format(maDate, "yyyy/mm/dd") 'MsgBox "Le date introduite est : " & Format(maDate, "dd/mm/yyyy") 'ErrAgent_Exit: 'Exit Sub ErrAgent: MsgBox "Le format de la date de naissance est incorrect !", vbCritical + vbOKOnly, "Erreur date" TextBox11 = "": TextBox11.SetFocus 'Resume ErrAgent_Exit End Sub
Merci à tous pour vos précieuses aides.

Bonjour,

Citation:

le blocage ne fonctionne pas dans mon test.

Il faut enlever le "Exit sub"

Pour le test sur la date complète:

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
 Private Sub TextBox11_Change()
    Dim Valeur As String
    TextBox11.MaxLength = 10 'nb caractères maxi autorisé dans le textbox
    Valeur = Len(TextBox11)
 
    If Valeur = 2 Or Valeur = 5 Then
        TextBox11 = TextBox11 & "/"
    ElseIf Valeur = 10 Then
        If Format(DateSerial(Year(Date), Month(Date), Day(Date)) * 1 - DateSerial(Year(TextBox11), Month(TextBox11), Day(TextBox11)) * 1, "yy") * 1 < 18 Then
            MsgBox "Format incorrect"
            TextBox11 = ""
        End If
        If Not IsDate(Format(Replace(TextBox11, ".", "/"), "yyyy/mm/dd")) Then
            MsgBox "Format incorrect"
            TextBox11 = ""
        End If
    End If
End Sub

Cdlt

Bonsoir Arturo83 et le forum

Merci pour votre solution.
Elle fonctionne suivant les conditions déjà définies.
J'ai constaté que lorsque la date saisie est supérieur à la date du jour (ce qui induira un âge négatif), il n'y a pas de blocage.
J'ai essayé de faire une déduction à partir de votre solution pour que le système signale une date erronée lorsque la date saisie est postérieure à la date du jour mais je rencontre un débogage:
Code:

1 2 3 4 If Format(DateSerial(Year(Date), Month(Date), Day(Date)) * 1 - DateSerial(Year(TextBox11), Month(TextBox11), Day(TextBox11)) * 1, "yy") * 1 < 0 Then MsgBox "Format incorrect" TextBox11 = "" End If
Ci-dessous le code intégral de mon adaptation:
Code:

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 Private Sub TextBox11_Change() Dim Valeur As String TextBox11.MaxLength = 10 'nb caractères maxi autorisé dans le textbox Valeur = Len(TextBox11) If Valeur = 2 Or Valeur = 5 Then TextBox11 = TextBox11 & "/" ElseIf Valeur = 10 Then If Format(DateSerial(Year(Date), Month(Date), Day(Date)) * 1 - DateSerial(Year(TextBox11), Month(TextBox11), Day(TextBox11)) * 1, "yy") * 1 < 18 Then MsgBox "Format incorrect" TextBox11 = "" End If If Format(DateSerial(Year(Date), Month(Date), Day(Date)) * 1 - DateSerial(Year(TextBox11), Month(TextBox11), Day(TextBox11)) * 1, "yy") * 1 < 0 Then MsgBox "Erreur sur la date" TextBox11 = "" End If If Not IsDate(Format(Replace(TextBox11, ".", "/"), "yyyy/mm/dd")) Then MsgBox "Format incorrect" TextBox11 = "" End If End If End Sub
Le débogage porte sur cette ligne:

Code:

If Format(DateSerial(Year(Date), Month(Date), Day(Date)) * 1 - DateSerial(Year(TextBox11), Month(TextBox11), Day(TextBox11)) * 1, "yy") * 1 < 0 Then

Comment faire pour que ma préoccupation puisse être prise en compte?
Encore merci

Bonsoir

Citation:

Envoyé par capi81

Le débogage porte sur cette ligne:

Code:

If Format(DateSerial(Year(Date), Month(Date), Day(Date)) * 1 - DateSerial(Year(TextBox11), Month(TextBox11), Day(TextBox11)) * 1, "yy") * 1 < 0 Then

Le format d'un contrôle textbox est du texte et donc ce n'est pas une date. Je te propose plutôt ceci :
- l'on vérifie que c'est une date
- l'on vérifie ensuite si elle n'est pas trop récente avec Cdate qui la transforme en date
Code:

1 2 3 4 5 6 If Not IsDate(TextBox11.Value) Then MsgBox "Format incorrect" ElseIf CDate(TextBox11.Value) + 18 * 365 > Date Then MsgBox "Date trop récente" TextBox11 = "" End If

Bonsoir Anasecu

Merci pour ta solution.
Ci-dessous le code intégral qui gère tout:

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
Private Sub TextBox11_Change()
    Dim Valeur As String
    TextBox11.MaxLength = 10 'nb caractères maxi autorisé dans le textbox
    Valeur = Len(TextBox11)
 
    If Valeur = 2 Or Valeur = 5 Then
        TextBox11 = TextBox11 & "/"
    ElseIf Valeur = 10 Then
        'If Format(DateSerial(Year(Date), Month(Date), Day(Date)) * 1 - DateSerial(Year(TextBox11), Month(TextBox11), Day(TextBox11)) * 1, "yy") * 1 < 18 Then
          '  MsgBox "Erreur sur date de naissance ou Age du client inférieur à 18ans"
          '  TextBox11 = ""
        'End If
        If Not IsDate(TextBox11.Value) Then
            MsgBox "Format incorrect"
        ElseIf CDate(TextBox11.Value) + 18 * 365 > Date Then
            MsgBox "Date trop récente"
            TextBox11 = ""
        End If
    End If
End Sub

Merci à vous et à tout ceux qui m'ont fait des propositions.