Calcul de l'age complet

Soyez le premier à donner votre avis sur cette source.

Snippet vu 6 368 fois - Téléchargée 37 fois

Contenu du snippet

Voici un calcul de l'age en fonction de 2 dates. Il est cour et donne le nombre d'années, de mois et de jours.

Source / Exemple :


Public Function Age(D1 As Date, D2 As Date) As String
Dim Annees As Long, Mois As Long, Jours As Long, DecalMois As Long ', Borne As Long
On Error GoTo Erreur:

  If D1 > D2 Then
    Age = "Dates invalides."
    Exit Function
  End If
  
  DecalMois = IIf(Day(D2) < Day(D1), 1, 0)
  
  Annees = Year(D2) - Year(D1) - _
            Switch(Month(D2) < Month(D1), 1, _
                  Month(D2) = Month(D1), DecalMois, _
                  True, 0)
  
  Mois = (Month(D2) - Month(D1) - DecalMois + 12) Mod 12
  
  Jours = Day(D2) - Day(D1) + _
          DecalMois * Day(DateSerial(Year(D2), Month(D2), 1) - 1)
  
  Age = Trim(IIf(Annees > 0, Annees & " Année" & IIf(Annees > 1, "s", "") & " ", "") & _
              IIf(Mois > 0, Mois & " Mois ", "") & _
              IIf((Jours > 0) Or (Annees + Mois = 0), Jours & " Jour" & IIf(Jours > 1, "s", ""), "")) & "."
  
Exit Function
Erreur:
  Age = "Calcul impossible !"
End Function

Conclusion :


Bonne prog.

A voir également

Ajouter un commentaire Commentaire
Messages postés
132
Date d'inscription
mardi 31 octobre 2000
Statut
Membre
Dernière intervention
2 mai 2004

Je suis époustouflé !
J'ai fait un code qui donne le meme résultat que toi
(http://www.vbfrance.com/article.aspx?Val=10075 )
mais le tien est + optimisé, bravo !
A + Rnosat !

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.