Excel - Ingresar solo números en TextBox con formato de fecha

Tengo un formulario con un TextBox para ingresar fecha. Solo digito números porque el guion se coloca automáticamente. El problema se presenta cuando quiero borrar carácter por carácter de derecha a izquierda no me deja por el guion. ¿Cómo podría modificar el código para que permita borrar de esa forma?

Private Sub TextBox1_Change()
If Bandera = False Then
If Len(ActiveControl) > 10 Then
ActiveControl = Mid(ActiveControl, 1, 10)
MsgBox "lA fEcHa eStA CoMpLeTa"
Else
If Len(ActiveControl) = 2 Then
ActiveControl = ActiveControl & "-"
End If
If Len(ActiveControl) = 5 Then
ActiveControl = ActiveControl & "-"
End If
End If
End If

End Sub

Private Sub TextBox1_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
If KeyCode = 50 Then
Bandera = True
Else
Bandera = False
End If
End Sub

• Libro1.zip(10,8 KB)

Con estos cambios


Saludos.
\\//_

Buena solución.
Si por casualidad al intentar corregir la digitación borro uno de los guiones ya no puedo continuar la corrección porque se altera el formato fecha, tengo que escribir todo de nuevo. como en este caso.




Quizás la mejor solución sería al primer intento de borrar de derecha a la izquierda quede seleccionado el contenido para sobrescribir sobre ella.

Gracias Master Antoni por tu aporte me sirvió de mucho.
También al Master Dante Amor M. que me facilito el código que funciona exacto a lo que perseguía.

Aquí esta el código:

Option Explicit

Dim borrando As Boolean
Dim saliendo As Boolean

Private Sub TextBox1_Change()
Dim Char As String
Dim x As Date
Dim y As Date

If borrando Then Exit Sub

Char = Right(TextBox1.Text, 1)
Select Case Len(TextBox1.Text)
Case 1 To 2, 4 To 5, 7 To 10
If Char Like "#" Then
If Len(TextBox1) = 10 Then
On Error Resume Next
x = DateValue(TextBox1.Text)
y = DateSerial(Right(TextBox1, 4), Mid(TextBox1, 4, 2), Left(TextBox1, 2))
If Err = 0 And x = y Then
On Error GoTo 0
Exit Sub
Else
Err.Clear
On Error GoTo 0
TextBox1.SelStart = 0
TextBox1.SelLength = Len(TextBox1.Text)
MsgBox "Verificar la fecha en formato dd-mm-yyyy", vbCritical + vbOKOnly, "Error"
Exit Sub
End If
Else
If Len(TextBox1.Text) = 2 Or Len(TextBox1.Text) = 5 Then
TextBox1 = TextBox1 & "-"
End If
Exit Sub
End If
End If
Case 3, 6
If Char Like "-" Then Exit Sub
End Select
On Error Resume Next
TextBox1.Text = Left(TextBox1.Text, Len(TextBox1.Text) - 1)
TextBox1.SelStart = Len(TextBox1.Text)
End Sub

Private Sub TextBox1_Exit(ByVal Cancel As MSForms.ReturnBoolean)
Dim x As Date
Dim y As Date

If saliendo Then Exit Sub
If TextBox1.Text = "" Then Exit Sub
On Error Resume Next
x = DateValue(TextBox1.Text)
y = DateSerial(Right(TextBox1, 4), Mid(TextBox1, 4, 2), Left(TextBox1, 2))
If Err = 0 And x = y Then
On Error GoTo 0
Exit Sub
Else
Err.Clear
On Error GoTo 0
MsgBox "La fecha no es correcta", vbCritical + vbOKOnly, "Error"
TextBox1.Text = ""
End If
End Sub

Private Sub TextBox1_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
Dim llevo As String
If borrando Then Exit Sub
If KeyCode = 46 Then
TextBox1.Text = ""
Exit Sub
End If
If KeyCode = 8 Then
If Len(TextBox1.Text) = 3 Or Len(TextBox1.Text) = 6 Then
borrando = True
TextBox1.Text = Left(TextBox1.Text, Len(TextBox1.Text) - 1)
borrando = False
End If
End If
End Sub

Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
saliendo = True
End Sub