Contar años, meses y días access

Tengo la siguiente uda que seguro me podéis resolver.

Para calcular los años,, meses y días que han pasado entre dos fechas utilizdo el siguiente módulo que muy amablemente me paso un experto.

En un cuadro de texto pongo lo siguiente en origen de control

=SiInm(EsNulo([FINCONTRATO]) O Fecha()<=[FINCONTRATO];fncDiferenciaFechas([INICIOCONTRATO];Fecha());

Pues bien, me gustaría que en el caso de que todavía no hubiese llegado la fecha de inicio de contrato o bien no me apareciese nada o bien apareciese un signo de - y el nº de días (- 5 días ). Ahora mismo me parece el 5, es decir, aunque falten 5 días para que comience el contrato y por lo tanto tendría que ser -5 días

Muchas gracias por vuestra ayuda

Una brazo

Dim vMES As Double
Dim vDia As Double
Dim temp As Date
If IsNull(laFechaIni) Or IsNull(laFechaFin) Then
    fncDiferenciaFechas = ""
    Exit Function
End If
If laFechaIni > laFechaFin Then
    temp = laFechaIni
    laFechaIni = laFechaFin
    laFechaFin = temp
ElseIf laFechaIni = laFechaFin Then
    fncDiferenciaFechas = "1 días"
    Exit Function
End If
If Month(laFechaIni) > Month(laFechaFin) Then
    vaño = DateDiff("yyyy", laFechaIni, laFechaFin) - 1
Else
    vaño = DateDiff("yyyy", laFechaIni, laFechaFin)
End If
If Day(laFechaIni) > Day(laFechaFin) Then
    vMES = DateDiff("m", DateAdd("yyyy", vaño, laFechaIni), laFechaFin) - 1
    If vMES < 0 Then
        vMES = 12 + vMES
        vaño = vaño - 1
    End If
Else
    vMES = DateDiff("m", DateAdd("yyyy", vaño, laFechaIni), laFechaFin)
End If
vDia = DateDiff("d", DateAdd("m", vaño * 12 + vMES, laFechaIni), laFechaFin) + 1 ' Mod 7
If vaño = 1 Then
    fncDiferenciaFechas = vaño & " año"
ElseIf vaño > 1 Then
    fncDiferenciaFechas = vaño & " años"
End If
If vMES = 1 Then
    fncDiferenciaFechas = IIf(fncDiferenciaFechas = "", "", fncDiferenciaFechas & " y ") & vMES & " mes"
ElseIf vMES > 1 Then
    fncDiferenciaFechas = IIf(fncDiferenciaFechas = "", "", fncDiferenciaFechas & " y ") & vMES & " meses"
End If
If vDia = 1 Then
    fncDiferenciaFechas = IIf(fncDiferenciaFechas = "", "", fncDiferenciaFechas & " y ") & vDia & " día"
ElseIf vDia > 1 Then
    fncDiferenciaFechas = IIf(fncDiferenciaFechas = "", "", fncDiferenciaFechas & " y ") & vDia & " días"
End If
End Function

3 Respuestas

Respuesta
2

Cambia esta parte de la función:

If laFechaIni > laFechaFin Then
    temp = laFechaIni
    laFechaIni = laFechaFin
    laFechaFin = temp
ElseIf laFechaIni = laFechaFin Then
    fncDiferenciaFechas = "1 días"
    Exit Function
End If

por esta otra:

If laFechaIni = laFechaFin Then
    fncDiferenciaFechas = "1 días"
    Exit Function
End If

y ya te deberían salir  diferencias en negativo.

Hola...

He estado probando y dándole vueltas pero no me sale la diferencia en negativo.

Si sustituyo la función me dale los meses y días que faltan hasta completar el año.

Si me puedes echar una mano te lo agradezco.

Un abrazo

Perdona, pero te contesté un poco "a lo loco" sin fijarme del todo en que la función devuelve una cadena de texto, y con el cambio que te comentaba funciona solo si devuelve un número.

A ver si con esta otra modificación ya te funciona como quieres:

'--------------------------------------------------------------------------------------------
' Función para calcular la diferencia entre fechas en años, meses y días
'--------------------------------------------------------------------------------------------
Public Function fncDiferenciaFechas(ByVal laFechaIni As Date, ByVal laFechaFin As Date) As String
Dim vMes As Double
Dim vDia As Double
Dim vAño As Double
Dim temp As Date
Dim Negativo As Boolean
If IsNull(laFechaIni) Or IsNull(laFechaFin) Then
    fncDiferenciaFechas = ""
    Exit Function
End If
If laFechaIni > laFechaFin Then
    temp = laFechaIni
    laFechaIni = laFechaFin
    laFechaFin = temp
    Negativo = True
ElseIf laFechaIni = laFechaFin Then
    fncDiferenciaFechas = "1 días"
    Exit Function
End If
If Month(laFechaIni) > Month(laFechaFin) Then
    vAño = DateDiff("yyyy", laFechaIni, laFechaFin) - 1
Else
    vAño = DateDiff("yyyy", laFechaIni, laFechaFin)
End If
If Day(laFechaIni) > Day(laFechaFin) Then
    vMes = DateDiff("m", DateAdd("yyyy", vAño, laFechaIni), laFechaFin) - 1
    If vMes < 0 Then
        vMes = 12 + vMes
        vAño = vAño - 1
    End If
Else
    vMes = DateDiff("m", DateAdd("yyyy", vAño, laFechaIni), laFechaFin)
End If
vDia = DateDiff("d", DateAdd("m", vAño * 12 + vMes, laFechaIni), laFechaFin) + 1 ' Mod 7
If vAño = 1 Then
    fncDiferenciaFechas = vAño & " año"
ElseIf vAño > 1 Then
    fncDiferenciaFechas = vAño & " años"
End If
If vMes = 1 Then
    fncDiferenciaFechas = IIf(fncDiferenciaFechas = "", "", fncDiferenciaFechas & " y ") & vMes & " mes"
ElseIf vMes > 1 Then
    fncDiferenciaFechas = IIf(fncDiferenciaFechas = "", "", fncDiferenciaFechas & " y ") & vMes & " meses"
End If
If vDia = 1 Then
    fncDiferenciaFechas = IIf(fncDiferenciaFechas = "", "", fncDiferenciaFechas & " y ") & vDia & " día"
ElseIf vDia > 1 Then
    fncDiferenciaFechas = IIf(fncDiferenciaFechas = "", "", fncDiferenciaFechas & " y ") & vDia & " días"
End If
If Negativo Then fncDiferenciaFechas = "-" & fncDiferenciaFechas
End Function

Lo nuevo son 3 líneas: la declaración de la variable "Negativo" (Dim Negativo as Boolean), se le asigna el valor si la fecha inicial es mayor que la final (Negativo = True) en el segundo bloque If, y al final, si hay que ponerla en negativo, le añade el signo (If Negativo Then fncDiferenciaFechas = "-" & fncDiferenciaFechas)

Respuesta
2

Loles, te propongo otra solución. Mira el formulario. Al no saber como lo tienes construido lo pongo continuo que se ve mejor, ni cuando quieres ver los días para el vencimiento o si ya ha pasado. Y como a fin de cuentas las fechas, son números enteros, se reduce bastante la instrucción

Puedes ver que en el primero te pones lo que falta a contar desde hoy. En el segundo como la fecha inicio del contrato todavía no ha llegado no pone nada. El tercero como la fecha fincontrato ya ha pasado te dice los días que han pasado.

El código, en este caso, al no saber donde lo quieres, lo he puesto en el evento Al recibir el enfoque del cuadro de texto Diasvencimiento

Private Sub DiasVencimiento_GotFocus()
Dim años As Integer, meses As Integer, dias As Integer
años = Int((FinContrato - Date) / 365.24)
meses = Int((((FinContrato - Date) / 365.24) - Int((FinContrato - Date) / 365.24)) * 12)
dias = Int((((((FinContrato - Date) / 365.24) - Int((FinContrato - Date) / 365.24)) * 12) - Int((((FinContrato - Date) / 365.24) - Int((FinContrato - Date) / 365.24)) * 12)) * 30.437)
If FinContrato < Date Then
DiasVencimiento = "Han pasado " & DateDiff("d", FinContrato, Date) & " días"
ElseIf InicioContrato > Date Then
DiasVencimiento = ""
Else
DiasVencimiento = años & " " & "año(s)" & "," & meses & " " & "mes(es)" & "," & dias & " " & "dia(s)"
End If
End Sub
Respuesta
1

Y yo lo obsequio esta función para que no se complique con decimales y divisiones.

Public Function CalcEdad(Optional vFecha1 As Date, Optional vFecha2 As Date) As String
 '  Calcula la edad en Años, Meses y Días
 Dim vYears As Integer
 Dim vMeses As Integer
 Dim vDias As Integer
 Dim strDias As String
 Dim strMeses As String
 Dim strPeridos As String
 If Not IsDate(vFecha1) Then
    CalcEdad = ""
 End If
If vFecha1 > vFecha2 Then
  MsgBox "La primera fecha no puede ser mayor que la segunda", vbCritical, "Error..."
  Exit Function
End If
vMeses = DateDiff("m", vFecha1, vFecha2)
vDias = DateDiff("d", DateAdd("m", vMeses, vFecha1), vFecha2)
If vDias < 0 Then
 vMeses = vMeses - 1
vDias = DateDiff("d", DateAdd("m", vMeses, vFecha1), vFecha2)
End If
vYears = vMeses \ 12
vMeses = vMeses Mod 12
If vDias = 0 Then
  strDias = ""
ElseIf vDias = 1 Then
  strDias = " día "
ElseIf vDias > 1 Then
  strDias = " días "
End If
If vMeses = 0 Then
  strMeses = ""
ElseIf vMeses = 1 Then
  strMeses = " Mes "
Else
 strMeses = " Meses "
End If
If vYears = 0 Then
  strperiodos = ""
ElseIf vYears = 1 Then
  strperiodos = " Año, "
Else
 strperiodos = " Años, "
End If
 If vYears = 0 And vMeses = 0 And (vDias > 1 And vDias < 31) Then
   CalcEdad = vDias & " días"
 ElseIf vYears > 0 And vMeses = 0 And (vDias > 0 And vDias < 31) Then 'ok
   If vYears = 1 And vMeses = 0 Then
     strperiodos = " Año "
   Else
     strperiodos = " Años "
   End If
   CalcEdad = vYears & strperiodos & "y " & vDias & " días"
 ElseIf vYears > 0 And vMeses = 0 And vDias = 0 Then ''''gg
    If vYears = 1 Then
     strperiodos = " Año "
   Else
     strperiodos = " Años "
   End If
   CalcEdad = vYears & strperiodos
 ElseIf vYears = 0 And vMeses > 0 And (vDias > 0 And vDias < 31) Then
   CalcEdad = vMeses & strMeses & "y " & vDias & strDias
 ElseIf vYears = 0 And vMeses > 0 And vDias = 0 Then ' ok
   CalcEdad = vMeses & strMeses
 ElseIf vYears = 0 And vMeses = 0 And vDias > 0 Then  'ok
   CalcEdad = vDias & strDias
 ElseIf vYears > 0 And vMeses > 0 And vDias = 0 Then
    If vYears = 1 Then
     strperiodos = " Año y "
   Else
     strperiodos = " Años y "
   End If
   CalcEdad = vYears & strperiodos & vMeses & strMeses '
  ElseIf vYears = 0 And vMeses = 0 And vDias = 0 Then
   CalcEdad = "0 días"
 Else
   CalcEdad = vYears & strperiodos & vMeses & strMeses & "y " & vDias & strDias
 End If
End Function

Ejemplos de llamada:

?CalcEdad("28/04/2021",DATE) -- retorna 1 día

?CalcEdad("26/04/2021","28/04/2021")  --- retorna 2 días
?CalcEdad("26/03/2020","29/04/2021") -- retorna 1 Año, 1 Mes y 3 días

Ya es cuestión de su gusto.

Añade tu respuesta

Haz clic para o

Más respuestas relacionadas