Calculer l'age en annees, mois et jours

Soyez le premier à donner votre avis sur cette source.

Snippet vu 21 822 fois - Téléchargée 62 fois

Contenu du snippet

function permettant de calculer l'age de quelqu'un en annees, mois et jours.
Pas tres perfectionne, mais ca vaut le merite de participer. il faut presenter les donnees a la function au format dd/MM/yyyy. dateN est la date de naissance et dateCS la deuxieme date.

Cette function est basee sur (+/-) intelligence humaine et pas sur intelligence artificielle (en fait c'est a peu pres comme ca qu'on calcule l'age)

Source / Exemple :


Function CalculAge(DateN As String, DateCS As String) As String

If IsDate(DateN) = False Then Exit Function
If IsDate(DateCS) = False Then Exit Function

Dim jN1, jC1, mN1, mC1, aN1, aC1 As Integer
Dim Jage, Mage, Aage As Integer
Dim Jdif As Integer

jN1 = Day(DateN)
jC1 = Day(DateCS)
mN1 = Month(DateN)
mC1 = Month(DateCS)
aN1 = Year(DateN)
aC1 = Year(DateCS)

If aC1 < aN1 Then Exit Function
If aC1 = aN1 And mC1 < mN1 Then Exit Function
If aC1 = aN1 And mC1 = mN1 And jC1 < jN1 Then Exit Function

If aC1 = aN1 And mC1 = mN1 And jC1 = jN1 Then
     Mage = 0
     Jage = 0
     Aage = 0
     GoTo caline1
End If

'
' Permet de savoir le nombre de jours du mois (fevrier inclus)
Dim sdt1 As Date
Dim sdt2 As Date
sdt1 = DateValue("1" & "/" & mN1 & "/" & aN1)
sdt2 = DateValue("1" & "/" & mN1 + 1 & "/" & aN1)
Jdif = DateDiff("d", sdt1, sdt2)
'
'

If jC1 < jN1 Then
     If mC1 > mN1 Then
          Mage = (mC1 - 1) - mN1
          Jage = (jC1 + Jdif) - jN1
          Aage = aC1 - aN1
          GoTo caline1
     End If
     
     If mC1 = mN1 Then
          Aage = aC1 - 1 - aN1
          Mage = (mC1 + 11) - mN1
          Jage = (jC1 + Jdif) - jN1
          GoTo caline1
     End If
     
     If mC1 < mN1 Then
          Mage = (mC1 + 11) - mN1
          Jage = (jC1 + Jdif) - jN1
          Aage = aC1 - 1 - aN1
          GoTo caline1
     End If
     
End If

If jC1 >= jN1 Then
     If mC1 > mN1 Then
          Jage = jC1 - jN1
          Mage = mC1 - mN1
          Aage = aC1 - aN1
          GoTo caline1
     End If
     
     If mC1 = mN1 Then
          Jage = jC1 - jN1
          Mage = mC1 - mN1
          Aage = aC1 - aN1
          GoTo caline1
     End If
     
     If mC1 < mN1 Then
          Jage = jC1 - jN1
          Mage = (mC1 + 12) - mN1
          Aage = aC1 - 1 - aN1
          GoTo caline1
     End If
     
End If

caline1:

CalculAge = Aage & "a " & Mage & "m " & Jage & "j"

End Function

Conclusion :


merci pour votre commentaire.

A voir également

Ajouter un commentaire Commentaires
Messages postés
1491
Date d'inscription
dimanche 19 novembre 2000
Statut
Modérateur
Dernière intervention
7 juillet 2014

C'est tout ce que vous voulez sauf inutile
Messages postés
592
Date d'inscription
samedi 19 janvier 2002
Statut
Membre
Dernière intervention
4 décembre 2008

Vraiment inutile mais c le fun kan meme
Messages postés
6
Date d'inscription
mercredi 11 avril 2001
Statut
Membre
Dernière intervention
10 août 2005

si il y a une faille que j'ai trouve et corrige.

a la place de :

Dim sdt1 As Date
Dim sdt2 As Date
sdt1 = DateValue("1" & "/" & mN1 & "/" & aN1)
sdt2 = DateValue("1" & "/" & mN1 + 1 & "/" & aN1)
Jdif = DateDiff("d", sdt1, sdt2)
'
il faut mettre :


If mN1 <> 12 Then
Dim sdt1 As Date
Dim sdt2 As Date
sdt1 = DateValue("1" & "/" & mN1 & "/" & aN1)
sdt2 = DateValue("1" & "/" & mN1 + 1 & "/" & aN1)
Jdif = DateDiff("d", sdt1, sdt2)
Else
Jdif = 31
End If

Merci, ta fonction na pas de faille, la au moin mes ages vont bien fonctionner

Vous n'êtes pas encore membre ?

inscrivez-vous, c'est gratuit et ça prend moins d'une minute !

Les membres obtiennent plus de réponses que les utilisateurs anonymes.

Le fait d'être membre vous permet d'avoir un suivi détaillé de vos demandes et codes sources.

Le fait d'être membre vous permet d'avoir des options supplémentaires.