Gruppe
DatumZeit
Problem
Wie kann ich Eingaben in eine UserForm-TextBox im Format TTMMJJ in ein gültiges Datum umwandeln? Es soll ebenfalls eine Eingabeprüfung erfolgen.
ClassModule: frmDatum
Private Sub cmdWeiter_Click()
Unload Me
End Sub
Private Sub txtDatum_Change()
Dim dteEingabe As Date
Dim iDay As Integer, iMonth As Integer, iYear As Integer
If txtDatum.Text = "" Then Exit Sub
If Not IsNumeric(Right(txtDatum.Text, 1)) Then
Beep
txtDatum.SelStart = Len(txtDatum.Text) - 1
txtDatum.SelLength = 1
lblAusgabe.Caption = "Nur Ziffern erlaubt!"
Exit Sub
Else
lblAusgabe.Caption = ""
End If
iDay = CInt(Left(txtDatum.Text, 2))
Select Case Len(txtDatum.Text)
Case 0
Case 1
If iDay > 3 Then
Beep
txtDatum.SelStart = 0
txtDatum.SelLength = 1
lblAusgabe.Caption = "Maximal 31 Tage"
Else
lblAusgabe.Caption = ""
End If
Case 2
If iDay > 31 Then
Beep
txtDatum.SelStart = 0
txtDatum.SelLength = 2
lblAusgabe.Caption = "Maximal 31 Tage"
Else
lblAusgabe.Caption = ""
End If
Case 3
iMonth = CInt(Right(txtDatum.Text, 1))
If iMonth > 1 Then
Beep
txtDatum.SelStart = 2
txtDatum.SelLength = 1
lblAusgabe.Caption = "Maximal 12 Monate"
Else
lblAusgabe.Caption = ""
End If
Case 4
iMonth = CInt(Right(txtDatum.Text, 2))
If iMonth > 12 Then
Beep
txtDatum.SelStart = 2
txtDatum.SelLength = 2
lblAusgabe.Caption = "Maximal 12 Monate"
Else
lblAusgabe.Caption = ""
End If
Select Case iMonth
Case 2
If iDay > 29 Then
Beep
txtDatum.SelStart = 0
txtDatum.SelLength = 4
lblAusgabe.Caption = "Maximal 29 Tage"
Else
lblAusgabe.Caption = ""
End If
Case 4, 6, 9, 11
If iDay > 30 Then
Beep
txtDatum.SelStart = 0
txtDatum.SelLength = 4
lblAusgabe.Caption = "Maximal 30 Tage"
Else
lblAusgabe.Caption = ""
End If
End Select
Case 6
iMonth = CInt(Mid(txtDatum.Text, 3, 2))
iYear = CInt(Right(txtDatum.Text, 2))
If iYear Mod 4 > 0 And iMonth = 2 And iDay = 29 Then
Beep
txtDatum.SelStart = 0
txtDatum.SelLength = 6
lblAusgabe.Caption = "Maximal 28 Tage"
Else
dteEingabe = DateSerial(iYear, iMonth, iDay)
lblAusgabe.Caption = dteEingabe & vbLf & Format(dteEingabe, "dddd")
txtDatum.SelStart = 0
txtDatum.SelLength = 6
End If
End Select
End Sub
Private Sub txtDatum_Exit(ByVal Cancel As MSForms.ReturnBoolean)
If Len(txtDatum.Text) < 6 Then
Cancel = True
Beep
lblAusgabe.Caption = "Datum eingeben!"
End If
End Sub
ClassModule: Tabelle1
Private Sub cmdDialogAufruf_Click()
frmDatum.Show
End Sub