Live-Forum - Die aktuellen Beiträge
Datum
Titel
28.03.2024 21:12:36
28.03.2024 18:31:49
Anzeige
Archiv - Navigation
1728to1732
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Datum in Textbox vereinfacht eingeben
31.12.2019 07:45:17
Werner
Guten Morgen,
ich würde gerne erreichen, dass man in einer Textbox eines UF das Datum vereinfacht eingeben kann und dann das Format "31.12.2019" automatisch umgesetzt wird. Ich danke schon jetzt für die Rückmeldungen. Viele Grüße - Werner B.

3
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Datum in Textbox vereinfacht eingeben
31.12.2019 08:44:27
Nepumuk
Hallo Werner,
teste mal:
Option Explicit

Private mblnChange As Boolean

Private Sub CommandButton1_Click()
    Dim intTag As Integer, intMonat As Integer, intJahr As Integer
    Dim strYear As String
    With TextBox1
        If .TextLength > 5 And .TextLength < 10 Then
            strYear = Left$(CStr(Year(Date)), 10 - .TextLength) & Mid$(.Text, 7)
            If MsgBox("Das Jahr war unvollständig und wird" & vbLf & "automatisch in das Jahr " _
                & strYear & " konvertiert.", vbOKCancel, "Datumskorrektur") = vbCancel Then
                .SelStart = 6
                .SelLength = 10 - .TextLength
                .SetFocus
                Exit Sub
            Else
                .Text = Left$(.Text, 6) & Left$(CStr(Year(Date)), 10 - .TextLength) & Mid$(.Text, 7)
            End If
        End If
        If .TextLength = 10 Then
            On Error GoTo err_exit
            intTag = Cint(Mid$(.Text, 1, 2))
            intMonat = Cint(Mid$(.Text, 4, 2))
            intJahr = Cint(Mid$(.Text, 7, 4))
            Select Case intMonat
                Case 4, 6, 9, 11
                    If intTag > 30 Then
                        MsgBox "Der Monat " & MonthName(intMonat) & " hat nur 30 Tage", vbExclamation, "Hinweis"
                        .Text = Right$(.Text, 8)
                        .SelStart = 0
                        .SetFocus
                        Exit Sub
                    End If
                Case 2
                    If intJahr Mod 4 = 0 And (intJahr Mod 100 <> 0 Xor intJahr Mod 400 = 0) Then
                        If intTag > 29 Then
                            MsgBox "Der Monat Februar hat im Jahr " & CStr(intJahr) & _
                                " nur 29 Tage", vbExclamation, "Hinweis"
                            .Text = Right$(.Text, 8)
                            .SelStart = 0
                            .SetFocus
                            Exit Sub
                        End If
                    Else
                        If intTag > 28 Then
                            MsgBox "Der Monat Februar hat im Jahr " & CStr(intJahr) & _
                                " nur 28 Tage", vbExclamation, "Hinweis"
                            .Text = Right$(.Text, 8)
                            .SelStart = 0
                            .SetFocus
                            Exit Sub
                        End If
                    End If
            End Select
        Else
            If .TextLength = 0 Then
                MsgBox "Bitte ein Datum eingeben.", vbExclamation, "Hinweis"
            Else
                MsgBox "Das eingegebene Datum ist nicht korrekt.", vbExclamation, "Hinweis"
                .SelStart = 0
                .SelLength = .TextLength
            End If
            .SetFocus
            Exit Sub
        End If
        
        'Datum in Tabelle schreiben
        With Worksheets(1).Cells(1, 1)
            .NumberFormat = "dd.mm.yyyy"
            .Value = CDate(TextBox1.Text)
        End With
        
        CommandButton2.Value = True
        Exit Sub
        err_exit:
        MsgBox "Das eingegebene Datum ist nicht korrekt.", vbExclamation, "Hinweis"
        .SelStart = 0
        .SelLength = .TextLength
    End With
End Sub

Private Sub CommandButton2_Click()
    Call Unload(Object:=Me)
End Sub

Private Sub TextBox1_Change()
    If Not mblnChange Then
        With TextBox1
            If Len(.Text) = 2 Then .Text = .Text & "."
            If Len(.Text) = 5 Then .Text = .Text & "."
        End With
    End If
End Sub

Private Sub TextBox1_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
    With TextBox1
        If KeyCode = 8 And (.TextLength = 3 Or .TextLength = 6) Then
            mblnChange = True
            .Text = Left$(.Text, .TextLength - 1)
        End If
    End With
    mblnChange = False
End Sub

Private Sub TextBox1_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
    Select Case KeyAscii
        Case 42 To 45: KeyAscii = 46
        Case 46, 48 To 57
        Case Else: KeyAscii = 0
    End Select
    If KeyAscii <> 0 Then
        With TextBox1
            Select Case .TextLength
                Case 0
                    If KeyAscii > 51 Then
                        .Text = "0" & Chr$(KeyAscii)
                        KeyAscii = 0
                    ElseIf KeyAscii = 46 Then
                        KeyAscii = 0
                    End If
                Case 1
                    If KeyAscii = 46 Then
                        KeyAscii = 0
                        If .Text <> "0" Then .Text = "0" & .Text
                    Else
                        If Right$(.Text, 1) = "3" And KeyAscii > 49 Then KeyAscii = 0
                    End If
                Case 3
                    If KeyAscii = 46 Then KeyAscii = 0
                    If KeyAscii > 49 Then .Text = .Text & "0"
                Case 4
                    If KeyAscii = 46 Then
                        KeyAscii = 0
                        If Right$(.Text, 4) <> "0" Then .Text = Left$(.Text, 3) & "0" & Right$(.Text, 1)
                    Else
                        If Right$(.Text, 1) <> "0" And KeyAscii > 50 Then KeyAscii = 0
                    End If
                Case 5 To 9
                    If KeyAscii = 46 Then KeyAscii = 0
                Case 10
                    KeyAscii = 0
            End Select
        End With
    End If
End Sub

Gruß
Nepumuk
Anzeige
AW: Datum in Textbox vereinfacht eingeben
31.12.2019 09:00:46
Daniel
Hi
Kommt immer darauf an, was du unter "vereinfacht" verstehst.
Probiere mal folgenden Code im Exit- oder AfterUpdate-Event der Textbox (nicht im Change-Event), damit kannst du das Datum verkürzt eingeben, wie in einer Excelzelle.
If IsDate(Textbox1.Text) Then
Textbox1.Text = Format(CDate(Textbox1.Text), "DD.MM.YYYY")
Ende if

Gutes Neues
Daniel

300 Forumthreads zu ähnlichen Themen

Anzeige
Anzeige
Anzeige

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige