Bonjour à tous,
Beaucoup de question sur comment calculer l'âge d'une personne à partir de sa date de naissance ou bien le nombre d'année, de mois et de jour entre deux dates.
J'ai repris une fonction de @ROGER2327
La fonction : EcartDate(Debut As Date, Fin As Date, Optional Quoi As String = "", Optional Langue As String = ".fr")
Debut est la date de début de la période (c'est une vraie date au sens d'Excel pas du texte)
Fin est la date de début de la période (c'est une vraie date au sens d'Excel pas du texte)
Quoi est ce qu'on désire en sortie :
Vos avis, critiques et suggestions sont les bienvenues. Il faudrait aboutir à une fonction personnalisée avec un consensus "presque général".
Si c'est une mauvaise idée ou bien redondant alors je retirerai la fonction sans en être marri en aucune manière.
Le code est dans module1:
Beaucoup de question sur comment calculer l'âge d'une personne à partir de sa date de naissance ou bien le nombre d'année, de mois et de jour entre deux dates.
J'ai repris une fonction de @ROGER2327
La fonction : EcartDate(Debut As Date, Fin As Date, Optional Quoi As String = "", Optional Langue As String = ".fr")
Debut est la date de début de la période (c'est une vraie date au sens d'Excel pas du texte)
Fin est la date de début de la période (c'est une vraie date au sens d'Excel pas du texte)
Quoi est ce qu'on désire en sortie :
- ce paramètre est facultatif
- si quoi = 1 ou "a" ou "y" alors on retourne un nombre qui est le nombre d'année entre le Debut et la Fin
- si quoi = 2 ou "m" alors on retourne un nombre qui est le nombre de mois entre le Debut et la Fin
- si quoi = 3 ou "j" ou "d" alors on retourne un nombre qui est le nombre de jour entre le Debut et la Fin
- si quoi est omis ou différent des valeurs ci-dessus alors on retourne la durée (âge) en texte sous la forme texte : n an m mois j jour
- on adapte le texte de sortie avec les singuliers ou pluriels requis.
- ce paramètre est facultatif
- cet argument sera égal un court texte commençant par un point et suivi du suffixe internet (pour site du pays de la langue désirée)
- exemple de texte : .fr (français), .gb (anglais), .uk (anglais), .usa (américain), .de (allemand), .es (espagnol), .it (italien), .pt (portugais), .cor (corse)
- si Langue est omis ou bien ne correspond pas à une des traductions alors la langue sera le français
- dupliquer la dernière ligne de type texte = texte & "," & ".cor,annu,anni,m...
- remplacer cor par le code du pays parlant la langue désirée
- puis, séparées par des virgules, indiquer les traductions de an (au singulier puis au pluriel), de mois (au singulier puis au pluriel) et enfin de jour (au singulier puis au pluriel).
Vos avis, critiques et suggestions sont les bienvenues. Il faudrait aboutir à une fonction personnalisée avec un consensus "presque général".
Si c'est une mauvaise idée ou bien redondant alors je retirerai la fonction sans en être marri en aucune manière.
Le code est dans module1:
VB:
Function EcartDate(Debut As Date, Fin As Date, Optional Quoi As String = "", Optional Langue As String = ".fr")
' adapté d'un code de -> JP Mesters
Const defaut = ".fr"
Dim texte$, Nba&, Nbm&, Nbj&, Retenue&, s$, t, i&
If Debut > Fin Then EcartDate = "#CHRONOLOGIE!": Exit Function
texte = ".fr,an,ans,mois,mois,jour,jours" 'français (.fr)
texte = texte & "," & ".gb,year,years,month,months,day,days" 'anglais (.gb)
texte = texte & "," & ".uk,year,years,month,months,day,days" 'anglais (.uk)
texte = texte & "," & ".usa,year,years,month,months,day,days" 'américain (.usa)
texte = texte & "," & ".de,Jahr,Jahre,Monat,Monate,Tag,Tage" 'allemand (.de)
texte = texte & "," & ".es,año,años,mes,meses,día,días" 'espagnol (.es)
texte = texte & "," & ".it,anno,anni,mese,mesi,giorno,giorni" 'italien (.it)
texte = texte & "," & ".pt,ano,anos,mês,meses,dia,dias" 'portugais (.pt)
texte = texte & "," & ".cor,annu,anni,mese,mesi,ghjornu,ghjorni" 'corse (.cor)
Nba = Year(Fin) - Year(Debut)
Nbm = Month(Fin) - Month(Debut)
Nbj = Day(Fin) - Day(Debut)
Retenue = Day(DateSerial(Year(Fin), Month(Fin), 0))
If Nbj < 0 Then Nbm = Nbm - 1: Nbj = Nbj + Retenue
If Nbm < 0 Then Nba = Nba - 1: Nbm = Nbm + 12
Select Case Left(LCase(Quoi), 1)
Case "a", "y", "1"
EcartDate = Nba: Exit Function
Case "m", "2"
EcartDate = Nbm: Exit Function
Case "j", "d", "3"
EcartDate = Nbj: Exit Function
Case Else
Quoi = LCase(Quoi): Langue = LCase(Langue): t = Split(LCase(texte), ",")
If Left(Langue, 1) <> "." Then Langue = defaut
For i = 0 To UBound(t)
If Langue = t(i) Then Exit For
Next i
If i > UBound(t) Then i = 1
s = IIf(Nba = 0, "", IIf(Nba = 1, "1 " & t(i + 1), Nba & " " & t(i + 2)))
s = Trim(s & " " & IIf(Nbm = 0, "", IIf(Nbm = 1, "1 " & t(i + 3), Nbm & " " & t(i + 4))))
s = Trim(s & " " & IIf(Nbj = 0, "", IIf(Nbj = 1, "1 " & t(i + 5), Nbj & " " & t(i + 6))))
End Select
EcartDate = s
End Function
Dernière édition: