Obtener años meses y días con macro
Hace poco hice una consulta similar pero solo pedí que me ayuden en obtener la edad al ingresar la fecha de nacimiento en un DTPicker, un experto (Adriel Ortiz Mangia) me ayudo con este código:
Private Sub txt_FNac_LostFocus() Dim Edad As Integer Edad = Int((Date - txt_FNac) / 365) txt_Edad.Value = Edad End Sub
Lo adapté al evento Lostfocus de un textbox, pero encuentro una deficiencia, ya que si ingreso por ejemplo el año de nacimiento 01/12/1983 el resultado será "34" es correcto, el detalle es que si nos damos cuenta esta persona aun no cumple los 34 años mas bien tiene "33 Años con 2 meses y 0 días" esta edad la obtuve con una formula:
=SI(B3>0,SIFECHA(B3,HOY(),"Y") & " Años con " & SIFECHA(B3,HOY(),"ym") & " meses y " & SIFECHA(B3,HOY(),"md") & " dias.","-")
La consulta es especifica; como implemento el codigo que tengo actualmente para obtner el mismo resultado?
Espero puedan ayudarme almas caritativas muchas gracias...
Pdt. El evento lo quisiera en un textbox ya no en un DTPicker.
1 Respuesta
Yo también te di una respuesta, que con rounddown solucionaba esta problemática...
Si lo intente pero me muestra error, por el momento tengo esto:
Private Sub txt_nacimiento_LostFocus()
'
Dim Edad As Integer
'
validarfecha = IsDate(txt_nacimiento.Value)
'
If validarfecha = False Then
MsgBox ("Campo " & Range("L31") & " incorrecto"), vbInformation, "Error"
'txt_nacimiento.Activate
txt_nacimiento.BackColor = vbRed
ElseIf validarfecha = True Then
txt_nacimiento = CDate((txt_nacimiento))
txt_nacimiento.BackColor = vbWhite
'
Edad = DateDiff("yyyy", CDate(txt_nacimiento.Text), Date)
txt_Anios.Text = Int(Edad)
'
Dim anios As Integer
anios = txt_Anios.Value
If Not anios <= 69 Then
MsgBox "Autoridad tiene " & anios & " años, está en la edad límite!", vbInformation, "::: Advertencia :::"
End If
txt_eleccion.Activate
End If
End SubEsto funciona correcto, excepto por la referencia de la edad que me muestra el año completo, ahora si cambio esta linea:
txt_Anios.Text = Int(Edad))
por esta que me facilitaste:
txt_Edad.Value = ROUNDDOWN(Edad/365,0)
Me muestra el siguiente error:
Si, error mio.
Prueba con :
txt_Anios.Value = Application.WorksheetFunction.RoundDown(Edad / 365, 0)
Nada man, muestra como resultado "0" =`(
Debe ser que la variable edad ya la tenias dividida por 365 y el resultado al dividirlo otra vez por 365 da 0,00xxxx y por eso da 0.
Prueba con:
txt_Anios.Value = Application.WorksheetFunction.RoundDown(Edad, 0)
Ahí si funciona, pero me da el mismo resultado con la línea que ya tengo
txt_Anios.Text = Int(Edad) = "tu codigo"
Lo que quisiera es que muestre el resultado como se ve en el ejemplo que dejé ;)
"33 Años con 2 meses y 0 días" y solo muestra el resultado de la operación fecha de hoy - nacimiento = X. (numero entero), gracias.
Ahhhh, estaba confundido, mirate esto:
Sub edad()
Dim fecha_nac As Date
Dim años As Integer
Dim mes_ant As Integer
Dim fecha_ant As Date
Dim dias As Integer
fecha_nac = InputBox("Indique fecha de nacimiento" & Chr(13) & Chr(13) & "Formato XX/XX/XXXX")
If Month(Now()) = 1 Then
mes_ant = 12
año_ant = Year(Now()) - 1
Else
mes_ant = Month(Now()) - 1
año_ant = Year(Now())
End If
fecha_ant = Day(fecha_nac) & "/" & mes_ant & "/" & año_ant
dias = Now() - fecha_ant
If Month(Now()) < Month(fecha_nac) Then
años = Year(Now()) - Year(fecha_nac) - 1
If Day(Now()) < Day(fecha_nac) Then
meses = 12 - Month(fecha_nac) + Month(Now()) - 1
Else
meses = 12 - Month(fecha_nac) + Month(Now())
End If
Else
If Month(Now()) = Month(fecha_nac) Then
If Day(Now()) < Day(fecha_nac) Then
años = Year(Now()) - Year(fecha_nac) - 1
Else
años = Year(Now()) - Year(fecha_nac)
End If
Else
años = Year(Now()) - Year(fecha_nac)
End If
End If
If Month(Now()) = Month(fecha_nac) Then meses = 0
If Day(Now()) = Day(fecha_nac) Then dias = 0
MsgBox años & " Años con " & meses & " meses y " & dias & " dias"
End Sub
