Textfeld Datumsformat Excel VBA

Question

Ich habe einen Code, der es mir erlaubt, Datum in Textbox1 manuell einzugeben, die dann im Kalender auf dem Benutzerformular ausgewählt wird. Es gibt ein zweites Textfeld, mit dem ich Daten hinzufügen oder entfernen kann. Der Code funktioniert perfekt.

Userform-Code -

Option Explicit 
Private Sub TextBox1_Exit(ByVal Cancel As MSForms.ReturnBoolean) 
    If IsDate(Me.TextBox1.Value) Then Me.Calendar1.Value = Me.TextBox1.Value 
End Sub 
Private Sub TextBox2_Exit(ByVal Cancel As MSForms.ReturnBoolean) 
    Dim dt As Date 
    With Me 
     If IsDate(.TextBox1.Value) Then 
      dt = CDate(.TextBox1.Value) + Val(.TextBox2.Value) 
      .TextBox1.Value = dt 
      .Calendar1.Value = dt 
     End If 
    End With 
End Sub 

Ich mag würde manuell Datum in textbox1 in einem bestimmten Format eingegeben werden.

Die Formate werden -

dd

ddmmm

ddmmmyyy

Ich bin nicht sicher, wie man einen Code zu schreiben, der dies tut.

Die Idee ist, Datum in einem der drei oben angegebenen Formate in Textfeld1 einzugeben, die dann im Kalender auf dem Benutzerformular ausgewählt wird.

Answer 1

bearbeitet nach Klärung op über erlaubte Formate

Sie auf den folgenden Code

Option Explicit 

Private Sub TextBox1_Exit(ByVal Cancel As MSForms.ReturnBoolean) 
    Dim txt As String, dayStr As String, monthStr As String, yearStr As String 
    Dim okTxt As Boolean 

    txt = Me.TextBox1.Value 
    Select Case Len(txt) 
     Case 2 
      dayStr = txt 
      okTxt = okDay(dayStr) 
      monthStr = month(Now) 
      yearStr = year(Now) 
     Case 5 
      dayStr = Mid(txt, 3, 3) 
      monthStr = Mid(txt, 3, 3) 
      okTxt = okDay(Left(txt, 2)) And okMonth(monthStr) 
      yearStr = year(Now) 
     Case 7 
      dayStr = Mid(txt, 3, 3) 
      monthStr = Mid(txt, 3, 3) 
      yearStr = Mid(txt, 6, 2) 
      okTxt = okDay(Left(txt, 2)) And okMonth(monthStr) And okYear(yearStr) 
    End Select 
    If Not okTxt Then 
     MsgBox "Invalid date" _ 
       & vbCrLf & vbCrLf & "Date must be input in one of the following formats:" _ 
       & vbCrLf & vbTab & "dd" _ 
       & vbCrLf & vbTab & "ddmmm" _ 
       & vbCrLf & vbTab & "ddmmmyy" _ 
       & vbCrLf & vbCrLf & "Please try again", vbCritical 

     Cancel = True 
    Else 
     Me.Calendar1.Value = CDate(Left(txt, 2) & " " & monthStr & " " & yearStr) 
    End If 
End Sub 

Function okDay(txt As String) As Boolean 
    okDay = CInt(txt) > 0 And CInt(txt) < 31 
End Function 

Function okMonth(txt As String) As Boolean 
    Const months As String = "JANFEBMARAPRMAJJUNJULAUGSEPOCTNOVDEC" 
    okMonth = InStr(months, UCase(txt)) > 0 
End Function 

Function okYear(txt As String) As Boolean 
    okYear = CInt(txt) > 0 And CInt(txt) < 200 '<--| set your "limit" years 
End Function