Operaciones con Fechas

[jues]

Saludos Amigos 

Tengo esta macro que me ayuda a calcular  la antigüedad  medida desde la fecha de ingreso hasta la fecha accidente sin embargo solo me da como resultado el año como un numero entero  y no me toma en cuenta la diferencia de los meses restantes entre ambas fechas la cual requiero expresar como decimales de forma anualizada :

Ejemplo:  15/08/2010 - 17/01/2004 = 13 Años (Resultado Actual)

                      15/08/2010 - 17/01/2004 =   05 meses de diferencia entre la fecha de ingreso  y la fecha del accidente 

                                                                                         05 meses / 12 Meses =  0,42 Años (Diferencia en Meses  Anualizada)

                       15/08/2010 - 17/01/2004 = 13, 42 años (Resultado Esperado)

Meses          Años

1/12              0,08

2/12              0,17

3/12              0,25

4/12              0,33

5/12              0,42

6/12              0,50

7/12              0,58

8/12              0,67

9/12              0,75

10/12            0,83

11/12            0,92

Private Sub TextBox8_Change()

' Calculo de la Antiguedad
    ' Definir una variable para la fecha del Accidente
    Dim fechaAccidente As Date
        
    ' Asignar la fecha del Accidente
    fechaAccidente = TextBox8
        
    ' Obtener la fecha de Ingreso
    fechaIngreso = TextBox7
        
    ' Calcular la Antiguedad
    Dim Antiguedad As Integer
    Antiguedad = Year(fechaAccidente) - Year(fechaIngreso)
    
    ' Ajustar la Antiguedad si aún no ha tenido su cumpleaños este año
    If fechaIngreso > DateSerial(Year(fechaAccidente), Month(fechaAccidente), Day(fechaAccidente)) Then
        Antiguedad = Antiguedad - 1
    End If
    
    ' Mostrar el resultado en la ventana de mensajes
    TextBox9 = Antiguedad

End Sub

De igual modo tengo esta otra macro  que me ayuda a calcular  la Edad  medida desde la fecha de nacimiento hasta la fecha actual:

Private Sub TextBox6_Change()

' Calculo de la Edad
    ' Definir una variable para la fecha de nacimiento
    Dim fechaNacimiento As Date
    
    ' Asignar la fecha de nacimiento
   fechaNacimiento = TextBox6
    
    ' Obtener la fecha actual
    Dim fechaActual As Date
    fechaActual = Date
    
    ' Calcular la Edad
    Dim edad As Integer
    edad = Year(fechaActual) - Year(fechaNacimiento)
        
    ' Ajustar la edad si aún no ha tenido su cumpleaños este año
    If fechaNacimiento > DateSerial(Year(fechaActual), Month(fechaActual), Day(fechaNacimiento)) Then
        edad = edad - 1
    End If
    
    ' Mostrar el resultado en la ventana de mensajes
    TextBox3 = edad
End Sub

Sin embargo no expresa el resultado que deseo ya que  el calculo correcto debe ser hecho desde la fecha de nacimiento hasta la fecha accidente pero al momento de replicar  el procedimiento en los siguientes términos me arroja un error:

Private Sub TextBox6_Change()

    ' Definir una variable para la fecha de nacimiento
    Dim fechaAccidente As Date
    
    ' Asignar la fecha de nacimiento
    fechaAccidente = TextBox8
    
    ' Asignar la fecha del Accidente
    fechaNacimiento = TextBox6
    
    ' Calcular la Edad
    Dim edad As Integer
    edad = Year(fechaAccidente) - Year(fechaNacimiento)
    
    ' Ajustar la edad si aún no ha tenido su cumpleaños este año
    If fechaNacimiento > DateSerial(Year(fechaAccidente), Month(fechaAccidente), Day(fechaAccidente)) Then
        edad = edad - 1
    End If
    
    ' Mostrar el resultado en la ventana de mensajes
    TextBox3 = edad
End Sub

Usuario: Prueba

Clave: Prueba12345

 Mucho les sabre agradecer la ayuda que me puedan brindar

PRUEBA.xlsm

[Antoni]

Prueba esta macro:

Sub Diferencia()
Dim Fecha As Date
Fecha = CDate("15/08/2010") '<---------- Tu fecha de ejemplo
MsgBox "Años: " & Round(DateDiff("m", Fecha, Date) / 12, 2)
End Sub

Nota: Los textbox  tiene formato texto, debes convertirlos a fecha antes de operar con ellos. (Función CDate)

[jues]

Saludos @Antoni

Disculpe lo novato creo que omití información o no me explique suficientemente bien lo que necesito es que dentro de la macro que ya tengo: 

Private Sub TextBox8_Change()

' Calculo de la Antiguedad
    ' Definir una variable para la fecha del Accidente
    Dim fechaAccidente As Date
        
    ' Asignar la fecha del Accidente
    fechaAccidente = TextBox8
        
    ' Obtener la fecha de Ingreso
    fechaIngreso = TextBox7
        
    ' Calcular la Antiguedad
    Dim Antiguedad As Integer
    Antiguedad = Year(fechaAccidente) - Year(fechaIngreso)
    
    ' Ajustar la Antiguedad si aún no ha tenido su cumpleaños este año
    If fechaIngreso > DateSerial(Year(fechaAccidente), Month(fechaAccidente), Day(fechaAccidente)) Then
        Antiguedad = Antiguedad - 1
    End If
    
    ' Mostrar el resultado en la ventana de mensajes
    TextBox9 = Antiguedad

End Sub

Se le pueda añadir o  integrar esa u otra línea de código que  efectué  el calculo  y me permita registrar los resultados  que combinen el número entero más los decimales anualizados  correspondientes a la Antigüedad de forma directa  en el TextBox9 

[Antoni]

Sub TextBox8_Change()
If IsDate(TextBox8) and IsDate(TextBox7) Then
   TextBox9 = Round(DateDiff("m", TextBox7, TextBox8) / 12, 2)
End If                                            
End Sub

 

[Antoni]

Corrijo:

Sub TextBox8_Change()
If IsDate(TextBox8) and IsDate(TextBox7) Then
   TextBox9 = Round(DateDiff("m", CDate(TextBox7), CDate(TextBox8)) / 12, 2)
End If                                            
End Sub

 

[jues]

hace 20 horas, Antoni dijo:

Corrijo:

Sub TextBox8_Change()
If IsDate(TextBox8) and IsDate(TextBox7) Then
   TextBox9 = Round(DateDiff("m", CDate(TextBox7), CDate(TextBox8)) / 12, 2)
End If                                            
End Sub

 

Saludos @Antoni espero este bien funciona excelente la solución que me envió , ¿tiene  alguna solución igual de buena para la segunda parte de mi pregunta respecto  al calculo de la edad hecho desde la Fecha de Nacimiento (TextBox6) hasta la Fecha del Accidente (TextBox8) que adicionalmente ajuste la edad si aún no ha tenido su cumpleaños ?

Agradecido de antemano.

[jues]

En 18/1/2024 at 12:12 , Antoni dijo:

Corrijo:

Sub TextBox8_Change()
If IsDate(TextBox8) and IsDate(TextBox7) Then
   TextBox9 = Round(DateDiff("m", CDate(TextBox7), CDate(TextBox8)) / 12, 2)
End If                                            
End Sub

 

Saludos Sr. @Antoni  espero este bien

He seguido intentando obtener la Edad en base a la macro que usted me envió sin embargo al replicar la macro y eliminar los decimales

Private Sub TextBox6_Change()

'Calculo de la Edad

If IsDate(TextBox8) And IsDate(TextBox6) Then

   TextBox3 = Round(DateDiff("m", CDate(TextBox6), CDate(TextBox8)) / 12)

End If

End Sub

No logro hacer que me compense la edad si no ha llegado a su cumpleaños, es decir:

24/01/2022 – 25/01/2024 = 2 años (Resultado Actual)

24/01/2023 – 25/01/2024 = 1 año (Resultado Esperado)

Adicionalmente para poder obtener resultado en el TextBox3 debo introducir los datos de forma inversa es decirTextBox8 y luego TextBox6 ya que en caso de introducirlos en el orden establecido TextBox6, TextBox7 y TextBox8 me indica que “Se ha producido un error 13 en tiempo de ejecución: no coinciden los tipos”

Agradecido de antemano en lo que me pueda ayudar.