RE:Calcular edad actual
Publicado por
Jeffrey (1 intervención) el 17/09/2007 22:59:07
Private Sub CommandButton1_Click()
If Not IsDate(Me.TextBox1.Text) Then
Me.TextBox3.Text = ""
Me.lblError.Caption = "Digite una fecha válida"
Else
Me.lblError.Caption = ""
CalculaEdad (Me.TextBox1.Text)
End If
End Sub
Private Sub CalculaEdad(ByVal FNaci As Date)
Dim FAct As String
Dim Anios As String
Dim Meses As String
Dim Dias As String
Dim newday As String
Dim newmonth As String
Dim newyear As String
FAct = Format(Now, "dd/MM/yyyy")
FNaci = Format(FNaci, "dd/MM/yyyy")
'Calcula los años
Anios = DateDiff("yyyy", CDate(Format(FNaci, "dd/MM/yyyy")), CDate(FAct))
'Si el mes actual es menor que el mes de la fecha de nacimiento entonces
If Month(CDate(FAct)) < Month(CDate(FNaci)) Then
'Restele uno a los años
Anios = Anios - 1
newmonth = Month(CDate(FAct)) + 12
Else
'Deje el mes actual tal y como estan
newmonth = Month(CDate(FAct))
End If
'Si el mes actual es igual al mes de la fecha de nacimiento entonces
If Month(CDate(FAct)) = Month(CDate(FNaci)) Then
'Si el día de la fecha actual es menor al día de la fecha de nacimiento
If Day(CDate(FAct)) < Day(CDate(FNaci)) Then
'Restele uno a los años
Anios = Anios - 1
End If
End If
If Day(CDate(FAct)) < Day(CDate(FNaci)) Then
newday = Day(CDate(FAct)) + 30
newmonth = newmonth - 1
Else
newday = Day(CDate(FAct))
End If
Meses = newmonth - Month(CDate(FNaci))
Dias = newday - Day(CDate(FNaci))
If FNaci <= FAct Then
Me.TextBox3.Text = Anios & " Años, " & Meses & " Meses, " & Dias & " Dias."
Else
Me.TextBox3.Text = "Fecha Inválida"
End If
End Sub