Calculer l’âge précis d’une personne

Accueil – Le CFO masqué Forums VBA Calculer l’âge précis d’une personne

  • Ce sujet contient 10 réponses, 2 participants et a été mis à jour pour la dernière fois par Pimpin, le il y a 4 années et 3 mois.
11 sujets de 1 à 11 (sur un total de 11)
  • Auteur
    Articles
  • #72807
    Pimpin
    Participant

    Bonjour,

    A partir d’une date valide saisie (JJ/MM/AAAA) dans une TEXTBOX, je voudrais calculer l’âge précis d’une personne. Exemple :

    Date de naissance : 15/03/2000
    Vous avez : 20 ans 4 mois et 15 jours.

    Bien sûr on affiche pas le mois ou le jours, s’ils sont égalent à 0.

    Date de naissance : 15/07/2000
    Vous avez : 20 ans 0 mois et 15 jours (non).
    Vous avez : 20 ans et 15 jours (oui).

    Et si c’est la date d’anniversaire :

    Date de naissance : 30/07/2000
    Vous avez : 20 ans 0 mois et 0 jours (non).
    Vous avez : 20 ans aujourd’hui, JOYEUX ANNIVERSAIRE (oui).

    Merci pour votre aide.

    #73170
    Lionel
    Participant

    Salut Pimpin,
    Voici ce que je te propose :

    Sub DateNaiss()
    Dim NbAns As Long, NbMois As Long, NbJours As Long
    Dim Tmp As Date, sA As String, sM As String, sJ As String
    
    DateDebut = "Ce n'est pas une date !"
    While Not IsDate(DateDebut)
        DateDebut = InputBox("Entrez une date", "Date", DateDebut)
    Wend
    DateFin = Now()
        Tmp = DateSerial(Year(DateFin), Month(DateDebut), Day(DateDebut))
        NbAns = Year(DateFin) - Year(DateDebut) + (Tmp > DateFin)
        NbMois = Month(DateFin) - Month(DateDebut) - (12 * (Tmp > DateFin))
        NbJours = Day(DateFin) - Day(DateDebut)
     
        If NbJours < 0 Then
            NbMois = NbMois - 1
            NbJours = Day(DateSerial(Year(DateFin), Month(DateFin), 0)) + NbJours
        End If
     
        If NbAns = 0 Then sA = "" Else _
            If NbAns = 1 Then sA = NbAns & " an " Else sA = NbAns & " ans "
        If NbMois = 0 Then sM = "" Else sM = NbMois & " mois "
        If NbJours = 0 Then sJ = "" Else
            If NbJours = 1 Then sJ = NbJours & " jour" Else sJ = NbJours & " jours"
         
        If NbMois = 0 And NbJours = 0 Then
            DiffDateAMJ = "Vous avez : " & Trim$(sA) & " aujourd'hui, JOYEUX ANNIVERSAIRE"
            Else: DiffDateAMJ = "Vous avez : " & Trim$(sA & sM & sJ)
        End If
        MsgBox DiffDateAMJ
    
    End Sub

    NB : je reviens vers toi dans quelques jours pour l’hôtel. 😉

    #73663
    Pimpin
    Participant

    Salut mon ami,

    Tu es trop fort, je n’ai pas encore tester ton programme.
    Mais je suis sûr que cela fonctionne vu la façon dont s’est écrit.
    Je te remercie donc sincèrement.

    #73664
    Pimpin
    Participant

    Oups !

    J’ai dû déclarer les variables :
    Dim DateDebut As String
    Dim DateFin As Date
    Dim DiffDateAMJ As string

    Sinon lorsque je clique sur “Annuler” je reste dans la boucle tant que je ne rentre pas une date.
    Et surtout la date ne respecte pas le format JJ/MM/YYYY.
    Si je rentre 15/8/2010 ou 8/15/2010 ça me donne le même résultat.
    Mais sinon il est pas mal ton programme.

    #73685
    Lionel
    Participant

    Tu ajoutes ceci

    ...
    While Not IsDate(DateDebut)
        DateDebut = InputBox("Entrez une date", "Date", DateDebut)
        <strong>If DateDebut = "" Then Exit Sub</strong>
    Wend
    ...
    #73790
    Pimpin
    Participant

    Salut mon ami,

    Quand je rajoute cette ligne comme tu m’as dit :

    If DateDebut = “” Then Exit Sub

    Cela me donne l’erreur suivante :

    Erreur de compilation
    Erreur de syntaxe
    Attendu : numéro de ligne ou étiquette ou instruction ou fin d’instruction.

    Sinon pour la date je veux la saisir dans une textbox (txt_datenaissance) et non dans une inputbox.
    Mais cela ne change rien au résultat. Aucun des 2 ne tient compte du format demandé :
    Je veux ce format “DD/MM/YYYY”
    et il me fait à sa tête “MM/DD/YYYY”.
    Sauf si je rentre une date ainsi 2/13/1988 il change en mettant 13/02/1988.
    Mais si je tape le 3/9/88 il me le change en 09/03/1988 ????.
    De plus quand je vérifie dans l’écriture dans le fichier il me met 9/3/1988 au lieu de 09/03/1988.
    Je suis obligé de le faire manuellement.

    Merci pour ton aide.

    #73846
    Lionel
    Participant

    Si tu veux forcer voici un autre code. J’ai créé vite fait un UserForm1 avec un TextBox1.

    Private Sub CommandButton1_Click()
        
        DateDebut = TextBox1.Value
        DateFin = Now()
        Tmp = DateSerial(Year(DateFin), Month(DateDebut), Day(DateDebut))
        NbAns = Year(DateFin) - Year(DateDebut) + (Tmp > DateFin)
        NbMois = Month(DateFin) - Month(DateDebut) - (12 * (Tmp > DateFin))
        NbJours = Day(DateFin) - Day(DateDebut)
     
        If NbJours < 0 Then
            NbMois = NbMois - 1
            NbJours = Day(DateSerial(Year(DateFin), Month(DateFin), 0)) + NbJours
        End If
     
        If NbAns = 0 Then sA = "" Else _
            If NbAns = 1 Then sA = NbAns & " an " Else sA = NbAns & " ans "
        If NbMois = 0 Then sM = "" Else sM = NbMois & " mois "
        If NbJours = 0 Then sJ = "" Else
            If NbJours = 1 Then sJ = NbJours & " jour" Else sJ = NbJours & " jours"
         
        If NbMois = 0 And NbJours = 0 Then
            DiffDateAMJ = "Vous avez : " & Trim$(sA) & " aujourd'hui, JOYEUX ANNIVERSAIRE"
        Else
            DiffDateAMJ = "Vous avez : " & Trim$(sA & sM & sJ)
        End If
        MsgBox DiffDateAMJ
        Unload UserForm1
        
    End Sub
    
    Private Sub TextBox1_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
        If KeyCode = 8 Then
            If Right(TextBox1, 1) = "/" Then TextBox1 = Mid(TextBox1, 1, Len(TextBox1) - 1)
        ElseIf KeyCode = 46 Then TextBox1 = ""
        End If
    End Sub
     
     
    Private Sub TextBox1_KeyUp(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
        If KeyCode < 96 Or KeyCode > 105 Then
            If TextBox1 <> "" Then TextBox1 = Left(TextBox1, Len(TextBox1) - 1)
        End If
        Select Case Len(TextBox1.Text)
        Case 2: If Val(TextBox1.Value) > 31 Then TextBox1.Value = "": MsgBox "jour trop grand" Else TextBox1 = TextBox1 & "/"
        Case 5: If Mid(TextBox1, 4, 2) > 12 Then TextBox1.Value = Mid(TextBox1, 1, 3): MsgBox "mois  trop grand" Else TextBox1 = TextBox1 & "/"
        Case 10: If Not IsDate(TextBox1) Then MsgBox "tu veux une claque ou quoi?" & vbCrLf & " Ou ta vu que ce jour existe dans le calendrier" & vbCrLf & " allez recommence!!!": TextBox1 = ""
        Case 11: TextBox1 = Mid(TextBox1, 1, 10)
        End Select
    End Sub
    #73929
    Pimpin
    Participant

    Merci mon ami,

    Je vais le tester et je te tiens au jus !

    Passe une bonne soirée

    #73945
    Pimpin
    Participant

    Il est pas mal ton programme. J’ai remarqué que tu contrôles bien le jour et le mois. Mais je voudrais aussi
    forcer l’année à 4 chiffres ça évitera des erreurs aussi. Et je veux que l’année autorisée soit comprise entre :
    now-120 ans <= année autorisée < now.
    Oui je sais que je suis pointilleux lol…
    Sinon est-ce que j’ai été clair dans ma requête ?

    #74458
    Lionel
    Participant

    Une nouvelle épreuve :

    Private Sub CommandButton1_Click()
        
        DateDebut = TextBox1.Value
        DateFin = Now()
        
        Tmp = DateSerial(Year(DateFin), Month(DateDebut), Day(DateDebut))
        NbAns = Year(DateFin) - Year(DateDebut) + (Tmp > DateFin)
        NbMois = Month(DateFin) - Month(DateDebut) - (12 * (Tmp > DateFin))
        NbJours = Day(DateFin) - Day(DateDebut)
     
        If NbJours < 0 Then
            NbMois = NbMois - 1
            NbJours = Day(DateSerial(Year(DateFin), Month(DateFin), 0)) + NbJours
        End If
     
        If NbAns = 0 Then sA = "" Else _
            If NbAns = 1 Then sA = NbAns & " an " Else sA = NbAns & " ans "
        If NbMois = 0 Then sM = "" Else sM = NbMois & " mois "
        If NbJours = 0 Then sJ = "" Else
            If NbJours = 1 Then sJ = NbJours & " jour" Else sJ = NbJours & " jours"
         
        If NbMois = 0 And NbJours = 0 Then
            DiffDateAMJ = "Vous avez : " & Trim$(sA) & " aujourd'hui, JOYEUX ANNIVERSAIRE"
        Else
            DiffDateAMJ = "Vous avez : " & Trim$(sA & sM & sJ)
        End If
        MsgBox DiffDateAMJ
        Unload UserForm1
        
    End Sub
    
    Private Sub TextBox1_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
        If KeyCode = 8 Then
            If Right(TextBox1, 1) = "/" Then TextBox1 = Mid(TextBox1, 1, Len(TextBox1) - 1)
        ElseIf KeyCode = 46 Then TextBox1 = ""
        End If
    End Sub
     
     
    Private Sub TextBox1_KeyUp(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
    
        If KeyCode < 96 Or KeyCode > 105 Then
            If TextBox1 <> "" Then TextBox1 = Left(TextBox1, Len(TextBox1) - 1)
        End If
        Select Case Len(TextBox1.Text)
        Case 2: If Val(TextBox1.Value) > 31 Then TextBox1.Value = "": MsgBox "Jour trop grand" Else TextBox1 = TextBox1 & "/"
        Case 5: If Mid(TextBox1, 4, 2) > 12 Then TextBox1.Value = Mid(TextBox1, 1, 3): MsgBox "Mois trop grand" Else TextBox1 = TextBox1 & "/"
        Case 10: If Not IsDate(TextBox1) Or Val(Mid(TextBox1, 7, 4)) < Val(Mid(Now(), 7, 4)) - 120 Or CDate(TextBox1) > Now() - 1 _
            Then MsgBox "N'importe quoi !" & vbCrLf & "Allez recommence!!!": TextBox1 = ""
        Case Is > 10: TextBox1 = Mid(TextBox1, 1, 10)
        End Select
    End Sub
    #74752
    Pimpin
    Participant

    Merci mon ami,

    Je pense qu’il sera bon ton programme.
    Je vais regarder tout ça à tête reposée ce week-end.
    Merci encore.
    @+

11 sujets de 1 à 11 (sur un total de 11)
  • Vous devez être connecté pour répondre à ce sujet.