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

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

• Cette réponse a été modifiée le il y a 3 années et 8 mois par Lionel.

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