Mascara para la fecha en un TextBox que funciona perfectamente pero si deseo borrar con el backspace no lo permite
Tengo una mascara para fecha que me funciona perfectamente en un Textbox y hace todo lo que requiero pero si se equivocan con la fecha y se desea borrar con el backspace después de que muestra el "/" no lo permite. No sé qué será. Si me pueden ayudar les agradecería mucho porque cuando eso pasa las personas tienen que se salirse del formulario y empezar de nuevo. Aquí les coloco la máscara:
Function Mascara_Fecha(ByRef TextBox3 As MSForms.TextBox, _
ByRef b_Borrar As Boolean)
Dim n As Byte, nl As Byte, lt As String
With TextBox3
If .Text = "" Then b_Borrar = False: Exit Function
nl = Len(.Text): lt = Mid(.Text, nl, 1)
Select Case nl
Case Is = 1
If Not IsNumeric(lt) Or Val(lt) > 3 Then .Text = ""
Case Is = 2
If Not IsNumeric(lt) Or Val(.Text) > 31 Or _
Val(.Text) < 1 Then
.Text = Left(.Text, nl - 1)
Else
.Text = .Text & "/"
End If
Case Is = 3
If b_Borrar Then .Text = Left(.Text, 1)
Case Is = 4
If Not IsNumeric(lt) Or _
Val(lt) > 1 Then .Text = Left(.Text, nl - 1)
Case Is = 5
If Not IsNumeric(lt) Or _
Val(Mid(.Text, nl - 1, 1) & lt) > 12 Or _
Val(Mid(.Text, nl - 1, 1) & lt) < 1 Then
.Text = Left(.Text, nl - 1)
Else
.Text = .Text & "/"
End If
Case Is = 6
If b_Borrar Then .Text = Left(.Text, 4)
Case Is = 8
If Not IsNumeric(lt) Or (Left(.Text, 2) = "29" And Mid(.Text, 4, 4) = "02" And _
Val(Right(.Text, 2)) Mod 4 > 0) Then _
.Text = Left(.Text, 11)
Case Is > 8
.Text = Left(.Text, 10)
Case Else
If Not IsNumeric(lt) Then .Text = Left(.Text, nl - 1)
End Select
End With
b_Borrar = False
End Function
En el formulario coloqué esto:
Private Sub TextBox3_Change()
Dim Borrar As Boolean
Mascara_Fecha TextBox3, Borrar
End Sub
2 respuestas
Cuando no te permita borrar más allá de la barra seleccioná todo el contenido y borrá para ingresar una nueva fecha.
Ahora, tu función tiene el inconveniente de que no evalúa si es un número cuando el año es de 4 dígitos.
Te presento otra macro (*) que te permite ingresar correctamente tanto años de 2 dígitos como de 4. También tiene el mismo proceso: se borra hasta el separador o se selecciona el tramo o todo el contenido para ingresarlo nuevamente.
(*) Macro extraída del manual Formularios (cap. 7.10)
Private Sub TextBox1_Change() 'FECHA formato ddmmaa 'x Elsamatilde If TextBox1 = "" Then Exit Sub Select Case Len(TextBox1) Case 2: If Right(TextBox1, 2) > 31 Then MsgBox "Debes ingresar nro de día entre el 01 al 31", , "" TextBox1 = Left(TextBox1, Len(TextBox1) - 2) Else TextBox1 = TextBox1 & "-" 'elegir el separador End If Case 5: If Right(TextBox1, 2) > 12 Then MsgBox "Debes ingresar nro de mes entre el 01 al 12", , "" TextBox1 = Left(TextBox1, Len(TextBox1) - 2) Else TextBox1 = TextBox1 & "-" 'elegir el separador End If Case 8: If Not IsNumeric(Right(TextBox1, 2)) Then MsgBox "Debes ingresar el año con 2 dígitos entre 00 y 99", , "" TextBox1 = Left(TextBox1, Len(TextBox1) - 2) End If Case 10: If Not IsNumeric(Right(TextBox1, 2)) Then MsgBox "Debes ingresar el año con 4 dígitos", , "" TextBox1 = Left(TextBox1, Len(TextBox1) - 2) End If End Select End Sub
Mi separador es el guión pero podés reemplazarlo por barras. Y también podés omitir los mensajes (Msgbox) si te parece.
Fíjate esto te puede ayudar