Function AMJ(borne1 As Date, borne2 As Date) As String
'------------------------------------------------------------------
' ' Principe :
' ' on se cale sur le jour de début
' ' chaque jour identique des mois suivants détermine X periodes mensuelles
' ' on deduit A le nombre d'années complètes (12 périodes mensuelles => ENT (X / 12)
' ' on deduit M le reliquat périodes mensuelles ( X modulo 12)
' ' on peut alors calculer J les jours résiduels
'------------------------------------------------------------------
Dim Ddeb As Date, DFin As Date
Dim A0 As Integer, M0 As Integer, J0 As Integer, X As Integer
Dim A As Integer, M As Integer, J As Integer
'============remise en ordre éventuel des bornes
Ddeb = Application.Min(borne1, borne2)
DFin = Application.Max(borne1, borne2)
' ------------------------------------------------------------------
A0 = Year(Ddeb)
' ===========mois anniversaire debut
M0 = Month(Ddeb)
'===========jour anniversaire debut
J0 = Day(Ddeb)
'------------------------------------------------------------------
' ===========on compte toutes les periodes mensuelles par rapport au jour anniversaire debut
X = 0
While DateSerial(A0, M0 + X, J0) <= DFin
A = Int(M / 12): M = X Mod 12: A = Int(X / 12)
X = X + 1
Wend
' ===========nombre de jours par rapport au dernier jour anniversaire pris en référence
' -------------------- X-1 permet la prise en compte du nombre de jour du mois précédent l'anniversaire
J = DFin - (DateSerial(A0, M0 + X - 1, J0))
'-------------------------------------------------------------------
' ===========mise en forme string AMJ (absences et pluriels)
Select Case A
Case 0: AMJ = ""
Case 1: AMJ = A & " an "
Case Else: AMJ = A & " ans "
End Select
Select Case M
Case 0: AMJ = AMJ & ""
Case Else: AMJ = AMJ & M & " mois "
End Select
Select Case J
Case 0: 'AMJ = AMJ
Case 1: AMJ = AMJ & J & " jour"
Case Else: AMJ = AMJ & J & " Jours"
End Select
' ==========contrôle éventuel
'AMJ & date anniversaire mois-1
'AMJ = AMJ & " " & Format(DateSerial(A0, M0 + X - 1, J0), "dd/mm/yy")
'End
End Function
