Discussion :

[capi81]

Bonsoir le forum

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

Code :

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

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

[ARTURO83]

Bonjour,

Ceci:

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 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

[Zekraoui_Jakani]

Vous pouvez adapter ce code à vos besoins:

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
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

[capi81]

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 :

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
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.

[ARTURO83]

Bonjour,

le blocage ne fonctionne pas dans mon test.

Il faut enlever le "Exit sub"

Pour le test sur la date complète:

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
 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

[capi81]

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 :

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

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 :

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
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 :

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

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

[anasecu]

Bonsoir

Le débogage porte sur cette ligne:

Code :

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

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 :

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

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

[capi81]

Bonsoir Anasecu

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

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
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.