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

buenas, te paso una posible solucion

 

saludos

fecha.xlsm

Hola, lo digitado no me reconoce como fecha. 

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 ?

Editado el el 18 de noviembre3 años por 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