Public Function rango(medad As Byte, msexo As String) As String
Dim dvalor As Double
dvalor = Nz(DLookup("[rango_alto]", "tblrangos", "edad=" & medad & " AND sexo='" & msexo & "'"), 0)
If dvalor > 0 Then
rango = "Para una persona de " & medad & " años " & msexo & " el rango alto es " & dvalor
Else
rango = "Rango no establecido..."
End If
End Function
Public Function CalcEdad(Optional ByVal vFecha1 As Date, Optional ByVal 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 strPeriodos 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 o está mal la fecha de destete", 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
