Calcul de l'age à partir d'une date dans une TextBox

Rebonjour la communauté,

Tout d'abord un grand merci à toutes celles et ceux qui m'ont déjà bien dépanné dans le passé.

J'ai un nouveau problème ... (un de plus).

J'ai une TextBox intitulée "datenaissanceBox"

J'ai une autre TextBox intitulée "dateBox"

Je souhaiterais que dans mon userform intitulé "nouveauprofilUF", lorsque je saisis une date au format jj/mm/aaa dans "datenaissanceBox" cela me calcule l'age de la personne automatiquement dans "ageBox". Et, qu'en cas d'erreur il puisse s'afficher le MsgBox "Erreur lors de la saise de la date. Merci de respecter le format date jj/mm/aaaa".

Si l'une ou l'un d'entr vous pouvait m'aider, ce serait génial.

Merci par avance.

Steph,

Pour vous aiguiller, voici le code fournit par l'IA Copilot...mais cela ne fonctionne pas !!!

Private Sub datenaissanceBox_Change()
Dim birthDate As Date
Dim age As Integer

' Vérifier si la date de naissance est valide
On Error GoTo ErrorHandler
If datenaissanceBox.value = "" Then
MsgBox "Veuillez entrer une date de naissance.", vbExclamation
Exit Sub
End If
birthDate = ConvertToDate(datenaissanceBox.value)

' Calculer l'âge
age = CalculateAge(birthDate)

' Afficher l'âge dans ageBox
ageBox.value = age
Exit Sub

ErrorHandler:
MsgBox "Veuillez entrer une date de naissance valide au format jj/mm/aaaa.", vbExclamation
End Sub

Function ConvertToDate(dateStr As String) As Date
On Error GoTo ErrorHandler
Dim dayPart As Integer
Dim monthPart As Integer
Dim yearPart As Integer
Dim dateParts() As String

dateParts = Split(dateStr, "/")
If UBound(dateParts) = 2 Then
dayPart = CInt(dateParts(0))
monthPart = CInt(dateParts(1))
yearPart = CInt(dateParts(2))

' Vérifier si les parties de la date sont valides
If dayPart > 0 And dayPart <= 31 And monthPart > 0 And monthPart <= 12 And yearPart > 0 Then
ConvertToDate = DateSerial(yearPart, monthPart, dayPart)
Else
Err.Raise vbObjectError + 1, "ConvertToDate", "Valeurs de date invalides"
End If
Else
Err.Raise vbObjectError + 1, "ConvertToDate", "Format de date invalide"
End If
Exit Function

ErrorHandler:
MsgBox "Erreur lors de la conversion de la date : " & Err.Description, vbExclamation
Resume Next
End Function

Function CalculateAge(birthDate As Date) As Integer
Dim age As Integer
age = Year(Date) - Year(birthDate)
If Month(birthDate) > Month(Date) Or (Month(birthDate) = Month(Date) And Day(birthDate) > Day(Date)) Then
age = age - 1
End If
CalculateAge = age
End Function

Bonjour,

Voici la fonction :

Public Function CalcAge(DateDeNaissance As Date)
    Dim zDate As Date
    CalcAge = Abs(DateDiff("YYYY", DateDeNaissance, Date))
    zDate = DateAdd("YYYY", CalcAge, DateDeNaissance)
    If zDate > Date Then CalcAge = CalcAge - 1
End Function

Et pour l'appel :

Private Sub datenaissanceBox_AfterUpdate()
    If IsDate(datenaissanceBox.Value Then
        dateBox.Value = CalcAge(datenaissanceBox.Value)
    Else
        Msgbox "Veuillez saisir une date valide !"
End If
End Sub

Écris à la volée donc pas testé...

Merci Jean-Paul,

Votre code plus une correction de synthaxe corrigée par copilot et c'est tout bon.

Encore merci pour votre aide.

Bonne soirée,

Steph,

Bonjour

Un essai à tester. Te convient-il ?

Bye !