Microsoft Excel

Excel und VBA: Formeln, Programmierung, Lösungen

Die Excel/VBA-Beispiele

Thema

TextBox-Eingaben im Format TTMMJJ in gültiges Datum umwandeln

Gruppe

Eingabe

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.

Lösung
Der Code befindet sich im Klassenmodul der UserForm.

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

    

Beiträge aus dem Excel-Forum zu den Themen DatumZeit und Eingabe