Buenas!
Detecté el otro día un 'pequeño' problema con la sistemática utilizada, y es que la gente de 89 años o más no tiene derecho a asistencia clínica, ya que si le aplicas la fecha de nacimiento que le toca, te lo considera como nacimiento en fecha posterior al día que tiene el sistema. Esto se debe a que sólo se pueden introducir fechas en formato corto, y cuando te pasas del año 2018 (18), pasa a ser el 2019 (19), cuando en realidad el señor nació en el 1919 (19 también).
Hice modificaciones, de tal manera que admite fechas cortas con separador("/") y sin él, pero también admite fechas largas con y sin separador.
En el cálculo final, en vez de grabar fecha corta, graba fecha larga, y en caso de teclear el año en fecha corta, te advierte de la edad que estás queriendo meter si ocurre lo de que te pasas de año, y si quieres seguir o abandonar.
El defecto ( que pudiera ser asumible), es en el caso de que tenga un nacimietno en el 1919 posteriro a la fecha de hoy. En este caso, con la fecha corta te da un aviso de fecha superior a la del sistema, por lo que no te deja seguir. Sin embargo, tenemos la opción de meter la fecha larga, tanto con barras como sin ellas, y lo admite sin más problemas. (ya te coge que es el 1919)
No parece necesario el intentar distinguir entre meses de 30 o 31 días, ya que la función 'IsDate' ya lo discierne sin problema (o eso parece).
En fin, que creo que sería conveniente considerar y hacer pruebas con este otro código que añado:
Código: Seleccionar todo
Sub ValidoFechasN (Evento)
oForm= Evento.Source.Model.Parent
SinBarras = Evento.Source.Text
'-------------------------------------------------
' Según la longitud de lo que se ha puesto como fecha y la existencia o no de barras, tendremos un resultado u otro
If Len(SinBarras)=0 Then Exit Sub ' Si no hay nada, nos echa de la macro
'---------------------------------------------
' Si lo que se escribe tiene solo 6 caracteres
if Len (SinBarras) = 6 Then ' Si solo son 6 caracteres
if Right(SinBarras,2) >Right(Date,2) Then ' Si el año es superior al actual
Respuesta= msgbox ("La persona se grabará con nacimiento el año " & 19 & Right(SinBarras,2) & Chr(13) & "¿Desea continuar?",52, "¡ATENCIÓN!" ) ' Nos avisa
if Respuesta=6 Then ' Si decimos que si
tmp = Mid(SinBarras, 1, 2) & "/"& Mid(SinBarras, 3, 2) & "/"& 19 & Right(SinBarras,2)' Pone la variable tmp en su valor ' Valor de la variable tmp
Else ' Si decimos que no
oCtrl = oForm.GetByName("FechaNac") ' Control FechaNac
oCtrl = oForm.Parent.Parent.CurrentController.GetControl(oCtrl) ' Tenemos el control sobre el control
oCtrl.SetFocus ' Le ponemos el foco encima
Evento.Source.Text="" ' Lo vaciamos
Respuesta=0 ' Colocamos la variable 'Respuesta' como no operativa
Exit sub ' Nos echa de la macro
End if ' Acabamos la condición de respuesta
Else ' Si el año es menor o igual
tmp= Mid(SinBarras, 1, 2) & "/" & Mid(SinBarras, 3, 2) & "/" & 20 & Right(SinBarras,2) ' La variable es distinta ' Si tiene 6 caracteres o si tiene 8 y no tiene '/' en la posición 6
End if ' Acaba la condición del año
End if ' Acaba la condición de la longitud
'-----------------------------------------------------------------------------
' Si tiene 8 caracteres puede ser porque tenga barras, o porque si no las tiene se ha puesto el año completo
if Len (SinBarras) = 8 Then ' Si son 8 caracteres
'----------------------------------------------------------
' Número de año incompleto (solo las dos últimas cifras)
if Mid(SinBarras, 3, 1)="/" and Mid(SinBarras, 6, 1)="/" Then ' Si tiene 8 caracteres y en la posición 3 y 6 tiene '/'
if Right(SinBarras,2) >Right(Date,2) Then ' Si el año señalado es superior al del sistema
Respuesta= msgbox ("La persona se grabará con nacimiento el año " & 19 & Right(SinBarras,2) & Chr(13) & "¿Desea continuar?",52, "¡ATENCIÓN!" ) ' Nos avisa
if Respuesta=6 Then ' Si decimos que si
tmp = Mid(SinBarras, 1, 6) & 19 & Right(SinBarras,2) ' Pone la variable tmp en su valor ' Valor de la variable tmp
Else ' Si decimos que no
oCtrl = oForm.GetByName("FechaNac") ' Control FechaNac
oCtrl = oForm.Parent.Parent.CurrentController.GetControl(oCtrl) ' Tenemos el control sobre el control
oCtrl.SetFocus ' Le ponemos el foco encima
Evento.Source.Text="" ' Lo vaciamos
Respuesta=0 ' Colocamos la variable 'Respuesta' como no operativa
Exit sub ' Nos echa de la macro
End if ' Acabamos la condición de respuesta
Else ' En caso de que sea menor o igual (el año)
tmp = Mid(SinBarras, 1, 6) & 20 & Right(SinBarras,2) ' La variable tmp tendrá otro valor
End if ' Acabamos la condición de año
End if ' Acabamos la condición de barras
'----------------------------------------------------------
' Número de año completo
if Mid(SinBarras, 3, 1)<>"/" and Mid(SinBarras, 6, 1)<>"/" Then ' Si tiene 8 caracteres y en las posiciónes 3 y 6 no tiene '/'
If Cint(right(SinBarras,4))< (Cint(right(Date, 4))-120) Then ' Si se teclea para 120 años
msgbox "Según la fecha anotada, el paciente tiene más de 120 años. Habría que teclear de nuevo" ' Nos aisa
oCtrl = oForm.GetByName("FechaNac") ' Control FechaNac
oCtrl = oForm.Parent.Parent.CurrentController.GetControl(oCtrl) ' Tenemos el control sobre el control
oCtrl.SetFocus ' Le ponemos el foco encima
Evento.Source.Text="" ' Lo vaciamos
Exit sub ' Nos echa de la macro
End if ' Acabamos con la condición de los 120 años
tmp = Mid(SinBarras, 1, 2) & "/" & Mid(SinBarras, 3, 2) & "/" & Right(SinBarras,4) ' Valor de la variable tmp
End if ' Acabamos la condición de barras
End if ' Acabamos la condición de longitud
'------------------------------------------
' En el caso de que haya 10 caracteres
if Len(SinBarras)=10 Then ' Si se han tecleado 10 caracteres
'----------------------------------------------
' Chequeamos que tenga formato correcto
if Mid(SinBarras, 3, 1)<>"/" or Mid(SinBarras, 6, 1)<> "/" Then ' Si tiene 10 caracteres y en las posiciones 3 o 6 no tiene '/'
msgbox "Formato no permitido" ' Nos avisa
oCtrl = oForm.GetByName("FechaNac") ' Control FechaNac
oCtrl = oForm.Parent.Parent.CurrentController.GetControl(oCtrl) ' Tenemos el control sobre el control
oCtrl.SetFocus ' Le ponemos el foco encima
Evento.Source.Text="" ' Lo vaciamos
Exit sub ' Nos echa de la macro
End if ' Acaba la condición de barras
'------------------------------------------------
' Si las barras están en su sitio, el año siempre ha de estar completo
if Mid(SinBarras, 3, 1)="/" and Mid(SinBarras, 6, 1)= "/" Then ' Si tiene 10 caracteres y en las posiciones 3 y 6 tiene '/'
'---------------------------------------------------------
' Si el año es superior al del sistema
If Cint(right(SinBarras,4))> (Cint(right(Date, 4))) Then ' Si el año es superior al actual
msgbox "Estás intentando grabar una fecha superior a la del sistema" ' Nos avisa
oCtrl = oForm.GetByName("FechaNac") ' Control FechaNac
oCtrl = oForm.Parent.Parent.CurrentController.GetControl(oCtrl) ' Tenemos el control sobre el control
oCtrl.SetFocus ' Le ponemos el foco encima
Evento.Source.Text="" ' Lo vaciamos
Exit sub ' Nos echa de la macro
End if ' Acaba la condición
'--------------------------------------------------------
' Si la edad va a ser superior a 120 años
If Cint(right(SinBarras,4))< (Cint(right(Date, 4))-120) Then ' Si tiene más de 120 años
msgbox "Según la fecha anotada, el paciente tiene más de 120 años. Habría que teclear de nuevo" ' Nos avisa
oCtrl = oForm.GetByName("FechaNac") ' Control FechaNac
oCtrl = oForm.Parent.Parent.CurrentController.GetControl(oCtrl) ' Tenemos el control sobre el control
oCtrl.SetFocus ' Le ponemos el foco encima
Evento.Source.Text="" ' Lo vaciamos
Exit sub ' Nos echa de la macro
End if ' Acabamos la condición de años
tmp = Mid(SinBarras, 1, 6) & Mid(SinBarras, 7, 4) ' Valor de la variable tmp
End if ' Acaba condición
End if ' Acaba la condición
'---------------------------------------------------------
' Comprobamos si la variable tmp es una fecha
If IsDate(tmp) = False Then ' Si no es una fecha
msgbox "Formato de fecha incorrecto!" ' Nos avisa
oCtrl = oForm.GetByName("FechaNac") ' Control FechaNac
oCtrl = oForm.Parent.Parent.CurrentController.GetControl(oCtrl) ' Tenemos el control sobre el control
oCtrl.SetFocus ' Le ponemos el foco encima
Evento.Source.Text="" ' Lo vaciamos
Exit sub ' Nos echa de la macro
Else ' Si sí que es fecha
'-----------------------------------------------------------
' Comprobamos si estamos señalando una fecha superior a la del sistema
if Clng(CDate(tmp))>Clng(Date) Then ' Si es mayor que la fecha actual
msgbox ("Fecha (" & tmp & ") superior a la actual (" & Format(Date, "dd/mm/yy") & ") " & Chr(13) & "Acción no permitida!", 16 , "SCS - HUMIC ©2018")
oCtrl = oForm.GetByName("FechaNac") ' Control FechaNac
oCtrl = oForm.Parent.Parent.CurrentController.GetControl(oCtrl) ' Tenemos el control sobre el control
oCtrl.SetFocus ' Le ponemos el foco encima
Evento.Source.Text="" ' Lo vaciamos
Exit sub ' Nos echa de la macro
End if ' Acabamos condición de fecha mayor que la del sistema
End if ' Acabamos la condición de que sea mayor que la fecha del sistema
'----------------------------------------------------------
' Si no es una fecha superior a la del sistema (pero es fecha), o es fecha admitida
oForm.getByName("FechaNac").BoundField.UpdateString(tmp) ' Control fecha graba la fecha de nacimiento
End Sub
Otro saludo!
)
) y modificando "algo".... ya que se escapaban detalles, como Fechas de 8 dígitos qué cogía como válidas (por ej: 12120018 y las ponía como 12/12/18), El control de los días mayores de 31 o 30 según los meses (excepto los de Febrero que Milagrosamente controla hasta los bisiestos) ya lo tengo CASI ultimado... pero ... SE ESCAPA EL GRABARLO, ya que...
