Ingresar solo números en TextBox con formato de fecha

[Jazo]

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

[JasallBcn]

buenas, te paso una posible solucion

 

saludos

fecha.xlsm

[Jazo]

Hola, lo digitado no me reconoce como fecha. 

[Jazo]

Para evitar esos detalles. Quizás la mejor solución sería si al primer intento de borrar de derecha a la izquierda quede seleccionado el contenido para sobrescribir sobre ella. Creo que asi seria mas practico.

Como se modificaría el código ?

[Jazo]

El Colega Dante Amor M. dio con la solución. 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