Function CalcularEdad(ByVal d1 As Date, ByVal d2 As Date)
Dim mmDay(0 To 12) As Integer
Dim fromDate As Date
Dim toDate As Date
Dim yy As Integer
Dim mm As Integer
Dim dd As Integer
Dim increment As Integer
Dim sAge As String
mmDay(0) = 31
mmDay(1) = 31
mmDay(2) = -1
mmDay(3) = 31
mmDay(4) = 30
mmDay(5) = 31
mmDay(6) = 30
mmDay(7) = 31
mmDay(8) = 31
mmDay(9) = 30
mmDay(10) = 31
mmDay(11) = 30
mmDay(12) = 31
'De menor a mayor
'****************
fromDate = d1
toDate = d2
If (d1 > d2) Then
fromDate = d2
toDate = d1
End If
increment = 0
'Day´s month
'***********
If day(fromDate) > day(toDate) Then
increment = mmDay(month(toDate) - 1)
End If
'if it is february month
'if it's to day is less then from day
'************************************
If increment = -1 Then
increment = 28
If IsLeap(toDate) Then
'leap year february contain 29 days
'**********************************
increment = 29
End If
End If
'Day Calculation
'***************
If increment <> 0 Then
dd = day(toDate) + increment - day(fromDate)
increment = 1
Else
dd = day(toDate) - day(fromDate)
End If
'Month calculation
'*****************
If (month(fromDate) + increment) > month(toDate) Then
mm = (month(toDate) + 12) - (month(fromDate) + increment)
increment = 1
Else
mm = month(toDate) - (month(fromDate) + increment)
increment = 0
End If
'year calculation
'****************
yy = year(toDate) - (year(fromDate) + increment)
'Armar la cadena de respuesta
'****************************
If yy > 0 And yy = 1 Then sAge = yy & " Año,"
If yy > 0 And yy > 1 Then sAge = yy & " Años,"
If mm > 0 And mm = 1 Then sAge = sAge & mm & " mes,"
If mm > 0 And mm > 1 Then sAge = sAge & mm & " meses,"
If dd > 0 And dd = 1 Then sAge = sAge & dd & " día"
If dd > 0 And dd > 1 Then sAge = sAge & dd & " días"
'Quitar coma sobrante
'********************
sAge = RTrim(LTrim(sAge))
If Len(sAge) > 0 Then
If Mid$(sAge, Len(sAge), 1) = "," Then sAge = Mid$(sAge, 1, Len(sAge) - 1)
End If
CalcularEdad = sAge
End Function
