Formatieren von MM/TT/JJJJ-Daten in Textfeld in VBA

Dies ist das gleiche Konzept wie die Antwort von Siddharth Rout. Ich wollte jedoch eine Datumsauswahl, die vollständig angepasst werden kann, damit das Erscheinungsbild an das Projekt angepasst werden kann, in dem es verwendet wird.

Sie können auf diesen Link klicken , um die benutzerdefinierte Datumsauswahl herunterzuladen, die ich mir vorgestellt habe. Nachfolgend sind einige Screenshots des Formulars in Aktion dargestellt.

Um die Datumsauswahl zu verwenden, importieren Sie einfach die Datei CalendarForm.frm in Ihr VBA-Projekt. Jeder der oben genannten Kalender kann mit einem einzigen Funktionsaufruf abgerufen werden. Das Ergebnis hängt nur von den Argumenten ab, die Sie verwenden (alle sind optional), sodass Sie es beliebig anpassen können.

Zum Beispiel kann der einfachste Kalender auf der linken Seite durch die folgende Codezeile erhalten werden:

MyDateVariable = CalendarForm.GetDate

Das ist alles dazu. Von dort geben Sie einfach die Argumente an, die Sie für den gewünschten Kalender benötigen. Der Funktionsaufruf unten erzeugt den grünen Kalender rechts:

MyDateVariable = CalendarForm.GetDate( _
    SelectedDate:=Date, _
    DateFontSize:=11, _
    TodayButton:=True, _
    BackgroundColor:=RGB(242, 248, 238), _
    HeaderColor:=RGB(84, 130, 53), _
    HeaderFontColor:=RGB(255, 255, 255), _
    SubHeaderColor:=RGB(226, 239, 218), _
    SubHeaderFontColor:=RGB(55, 86, 35), _
    DateColor:=RGB(242, 248, 238), _
    DateFontColor:=RGB(55, 86, 35), _
    SaturdayFontColor:=RGB(55, 86, 35), _
    SundayFontColor:=RGB(55, 86, 35), _
    TrailingMonthFontColor:=RGB(106, 163, 67), _
    DateHoverColor:=RGB(198, 224, 180), _
    DateSelectedColor:=RGB(169, 208, 142), _
    TodayFontColor:=RGB(255, 0, 0), _
    DateSpecialEffect:=fmSpecialEffectRaised)

Hier ist ein kleiner Vorgeschmack auf einige der Funktionen. Alle Optionen sind im Userform-Modul selbst vollständig dokumentiert:

• Benutzerfreundlichkeit Das Benutzerformular ist vollständig in sich abgeschlossen und kann in jedes VBA-Projekt importiert und ohne viel zusätzlichen Code verwendet werden.
• Einfaches, ansprechendes Design.
• Vollständig anpassbare Funktionalität, Größe und Farbschema
• Beschränken Sie die Benutzerauswahl auf einen bestimmten Datumsbereich
• Wählen Sie einen beliebigen Tag für den ersten Tag der Woche
• Geben Sie die Wochennummern an und unterstützen Sie den ISO-Standard
• Durch Klicken auf die Monats- oder Jahresbezeichnung in der Kopfzeile werden auswählbare Kombinationsfelder angezeigt
• Datumsangaben ändern die Farbe, wenn Sie mit der Maus darüber fahren

Fügen Sie etwas hinzu, um die Länge zu verfolgen und Sie können "prüfen", ob der Benutzer Text hinzufügt oder von ihm subtrahiert. Dies ist derzeit nicht getestet, aber etwas ähnliches sollte funktionieren (insbesondere wenn Sie ein Benutzerformular haben).

'add this to your userform or make it a static variable if it is not part of a userform
private oldLength as integer

Private Sub txtBoxBDayHim_Change()
    if ( oldlength > txboxbdayhim.textlength ) then
        oldlength =txtBoxBDayHim.textlength
        exit sub
    end if

    If txtBoxBDayHim.TextLength = 2 or txtBoxBDayHim.TextLength = 5 then
    txtBoxBDayHim.Text = txtBoxBDayHim.Text + "/"
    end if
    oldlength =txtBoxBDayHim.textlength
End Sub

Ich bin auch auf die eine oder andere Weise auf das gleiche Dilemma gestoßen, warum der Mist Excel VBA keinen Date Picker hat. Vielen Dank an Sid, der einen tollen Job gemacht hat, um etwas für uns alle zu schaffen. 

Trotzdem bin ich an einen Punkt gekommen, an dem ich meine eigenen schaffen muss. Und ich poste es hier, da viele Leute, denen ich sicher bin, in diesem Beitrag landen und davon profitieren.

Was ich gemacht habe, war sehr einfach als das, was Sid macht, außer dass ich kein temporäres Arbeitsblatt verwende. Ich dachte, die Berechnungen sind sehr einfach und unkompliziert, so dass es nicht nötig ist, sie an einem anderen Ort abzulegen. Hier ist die endgültige Ausgabe des Kalenders:

So richten Sie es ein:

• Erstellen Sie 42 Label-Steuerelemente, und benennen Sie sie nacheinander und von links nach rechts und von oben nach unten angeordnet (Diese Beschriftung enthält grau hinterlegte 25-Zeichen bis zu grau 5 oben). Ändern Sie den Namen der Label-Steuerelemente in Label_01, Label_02 usw. Legen Sie alle 42 Labels Tag-Eigenschaft auf dts fest.
• Erstellen Sie 7 weitere Label-Steuerelemente für die Kopfzeile (diese enthält Su, Mo, Tu ...).
• Erstellen Sie 2 weitere Label-Steuerelemente, eines für die horizontale Linie (auf 1 festgelegte Höhe) und eines für die Anzeige Month und Year. Nennen Sie das Label, das für die Anzeige von Monat und Jahr verwendet wird. Label_MthYr
• Fügen Sie 2 Image-Steuerelemente ein, eines enthält das linke Symbol, um die vorherigen Monate zu scrollen, und eines, um nächsten Monat zu scrollen (ich bevorzuge ein einfaches linkes und rechtes Pfeilsymbol). Nennen Sie es Image_Left und Image_Right.

Das Layout sollte mehr oder weniger so sein (ich überlasse die Kreativität jedem, der dies verwendet).

Erklärung:  
Wir benötigen eine ganz oben deklarierte Variable, um den aktuellen Monat ausgewählt zu halten.

Option Explicit
Private curMonth As Date

Private Prozedur und Funktionen:

Private Function FirstCalSun(ref_date As Date) As Date
    '/* returns the first Calendar sunday */
    FirstCalSun = DateSerial(Year(ref_date), _
                  Month(ref_date), 1) - (Weekday(ref_date) - 1)
End Function

Private Sub Build_Calendar(first_sunday As Date)
    '/* This builds the calendar and adds formatting to it */
    Dim lDate As MSForms.Label
    Dim i As Integer, a_date As Date

    For i = 1 To 42
        a_date = first_sunday + (i - 1)
        Set lDate = Me.Controls("Label_" & Format(i, "00"))
        lDate.Caption = Day(a_date)
        If Month(a_date) <> Month(curMonth) Then
            lDate.ForeColor = &H80000011
        Else
            If Weekday(a_date) = 1 Then
                lDate.ForeColor = &HC0&
            Else
                lDate.ForeColor = &H80000012
            End If
        End If
    Next
End Sub

Private Sub select_label(msForm_C As MSForms.Control)
    '/* Capture the selected date */
    Dim i As Integer, sel_date As Date
    i = Split(msForm_C.Name, "_")(1) - 1
    sel_date = FirstCalSun(curMonth) + i

    '/* Transfer the date where you want it to go */
    MsgBox sel_date

End Sub

Bildereignisse:

Private Sub Image_Left_Click()

    If Month(curMonth) = 1 Then
        curMonth = DateSerial(Year(curMonth) - 1, 12, 1)
    Else
        curMonth = DateSerial(Year(curMonth), Month(curMonth) - 1, 1)
    End If

    With Me
        .Label_MthYr.Caption = Format(curMonth, "mmmm, yyyy")
        Build_Calendar FirstCalSun(curMonth)
    End With

End Sub

Private Sub Image_Right_Click()

    If Month(curMonth) = 12 Then
        curMonth = DateSerial(Year(curMonth) + 1, 1, 1)
    Else
        curMonth = DateSerial(Year(curMonth), Month(curMonth) + 1, 1)
    End If

    With Me
        .Label_MthYr.Caption = Format(curMonth, "mmmm, yyyy")
        Build_Calendar FirstCalSun(curMonth)
    End With

End Sub

Ich fügte das hinzu, damit der Benutzer so aussieht, als ob der Benutzer auf das Etikett klickt, und sollte auch mit dem Image_Right-Steuerelement erfolgen.

Private Sub Image_Left_MouseDown(ByVal Button As Integer, ByVal Shift As Integer, _
                                 ByVal X As Single, ByVal Y As Single)
    Me.Image_Left.BorderStyle = fmBorderStyleSingle
End Sub

Private Sub Image_Left_MouseUp(ByVal Button As Integer, ByVal Shift As Integer, _
                               ByVal X As Single, ByVal Y As Single)
    Me.Image_Left.BorderStyle = fmBorderStyleNone
End Sub

Label-Events:  
All dies sollte für alle 42 Etiketten erfolgen (Label_01 bis Lable_42).
Tipp: Baue die ersten 10 und benutze einfach Suchen und Ersetzen für die restlichen.

Private Sub Label_01_Click()
    select_label Me.Label_01
End Sub

Dies dient zum Schweben über Datumsangaben und zum Klicken des Effekts.

Private Sub Label_01_MouseDown(ByVal Button As Integer, ByVal Shift As Integer, _
                               ByVal X As Single, ByVal Y As Single)
    Me.Label_01.BorderStyle = fmBorderStyleSingle
End Sub

Private Sub Label_01_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, _
                               ByVal X As Single, ByVal Y As Single)
    Me.Label_01.BackColor = &H8000000B
End Sub

Private Sub Label_01_MouseUp(ByVal Button As Integer, ByVal Shift As Integer, _
                             ByVal X As Single, ByVal Y As Single)
    Me.Label_01.BorderStyle = fmBorderStyleNone
End Sub

UserForm-Ereignisse:

Private Sub UserForm_Initialize()
    '/* This is to initialize everything */
    With Me
        curMonth = DateSerial(Year(Date), Month(Date), 1)
        .Label_MthYr = Format(curMonth, "mmmm, yyyy")
        Build_Calendar FirstCalSun(curMonth)
    End With

End Sub

Wieder nur für den Schwebeflug über Termine.

Private Sub UserForm_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, _
                               ByVal X As Single, ByVal Y As Single)

    With Me
        Dim ctl As MSForms.Control, lb As MSForms.Label

        For Each ctl In .Controls
            If ctl.Tag = "dts" Then
                Set lb = ctl: lb.BackColor = &H80000005
            End If
        Next
    End With

End Sub

Und das ist es. Dies ist roh und Sie können Ihren eigenen Twist hinzufügen. 
Ich benutze das schon eine Weile und habe keine Probleme (in Bezug auf Leistung und Funktionalität).
Noch kein Error Handling, kann aber einfach gemanagt werden.
Ohne die Auswirkungen ist der Code eigentlich zu kurz. 
In select_label können Sie festlegen, wo sich Ihre Daten befinden. HTH.

Für eine schnelle Lösung mag ich das normalerweise.

Dieser Ansatz ermöglicht es dem Benutzer, das Datum in einem beliebigen Format in das Textfeld einzugeben und schließlich das Format mm/tt/jjjj zu formatieren, wenn er die Bearbeitung abgeschlossen hat. Es ist also recht flexibel:

Private Sub TextBox1_Exit(ByVal Cancel As MSForms.ReturnBoolean)
    If TextBox1.Text <> "" Then
        If IsDate(TextBox1.Text) Then
            TextBox1.Text = Format(TextBox1.Text, "mm/dd/yyyy")
        Else
            MsgBox "Please enter a valid date!"
            Cancel = True
        End If
    End If
End Sub

Ich denke jedoch, dass das, was Sid entwickelt hat, ein viel besserer Ansatz ist - eine vollwertige Datumsauswahl.

Zum Spaß nahm ich Siddharths Vorschlag für separate Textboxen und machte Comboboxen. Bei Interesse fügen Sie ein Benutzerformular mit drei Kombinationsfeldern mit den Namen cboDay, cboMonth und cboYear hinzu und ordnen Sie diese von links nach rechts an. Fügen Sie dann den folgenden Code in das Code-Modul von UserForm ein. Die erforderlichen Combobox-Eigenschaften werden in UserFormInitialization festgelegt, sodass keine zusätzlichen Vorbereitungen erforderlich sind.

Der knifflige Teil ändert den Tag, an dem er aufgrund einer Änderung in Jahr oder Monat ungültig wird. Dieser Code setzt ihn in diesem Fall einfach auf 01 zurück und hebt cboDay hervor.

Ich habe irgendwann so etwas nicht codiert. Hoffentlich wird es eines Tages für jemanden interessant sein. Wenn nicht, hat es Spaß gemacht!

Dim Initializing As Boolean

Private Sub UserForm_Initialize()
Dim i As Long
Dim ctl As MSForms.Control
Dim cbo As MSForms.ComboBox

Initializing = True
With Me
    With .cboMonth
        '        .AddItem "month"
        For i = 1 To 12
            .AddItem Format(i, "00")
        Next i
        .Tag = "DateControl"
    End With
    With .cboDay
        '        .AddItem "day"
        For i = 1 To 31
            .AddItem Format(i, "00")
        Next i
        .Tag = "DateControl"
    End With
    With .cboYear
        '        .AddItem "year"
        For i = Year(Now()) To Year(Now()) + 12
            .AddItem i
        Next i
        .Tag = "DateControl"
    End With
    DoEvents
    For Each ctl In Me.Controls
        If ctl.Tag = "DateControl" Then
            Set cbo = ctl
            With cbo
                .ListIndex = 0
                .MatchRequired = True
                .MatchEntry = fmMatchEntryComplete
                .Style = fmStyleDropDownList
            End With
        End If
    Next ctl
End With
Initializing = False
End Sub

Private Sub cboDay_Change()
If Not Initializing Then
    If Not IsValidDate Then
        ResetMonth
    End If
End If
End Sub

Private Sub cboMonth_Change()
If Not Initializing Then
    ResetDayList
    If Not IsValidDate Then
        ResetMonth
    End If
End If
End Sub

Private Sub cboYear_Change()
If Not Initializing Then
    ResetDayList
    If Not IsValidDate Then
        ResetMonth
    End If
End If
End Sub

Function IsValidDate() As Boolean
With Me
    IsValidDate = IsDate(.cboMonth & "/" & .cboDay & "/" & .cboYear)
End With
End Function
Sub ResetDayList()
Dim i As Long
Dim StartDay As String

With Me.cboDay
    StartDay = .Text
    For i = 31 To 29 Step -1
        On Error Resume Next
        .RemoveItem i - 1
        On Error GoTo 0
    Next i
    For i = 29 To 31
        If IsDate(Me.cboMonth & "/" & i & "/" & Me.cboYear) Then
            .AddItem Format(i, "0")
        End If
    Next i
    On Error Resume Next
    .Text = StartDay
    If Err.Number <> 0 Then
        .SetFocus
        .ListIndex = 0
    End If
End With
End Sub

Sub ResetMonth()
Me.cboDay.ListIndex = 0
End Sub

Sie können auch eine Eingabemaske für das Textfeld verwenden. Wenn Sie die Maske auf ##/##/#### setzen, wird sie bei der Eingabe immer formatiert, und Sie müssen keine andere Kodierung vornehmen, als zu prüfen, ob das eingegebene Datum ein wahres Datum war.

Welches nur ein paar einfache Zeilen

txtUserName.SetFocus
If IsDate(txtUserName.text) Then
    Debug.Print Format(CDate(txtUserName.text), "MM/DD/YYYY")
Else
    Debug.Print "Not a real date"
End If

Ich stimme den in den folgenden Antworten genannten Themen zu. Ich schlage jedoch vor, dass dies ein sehr schlechtes Design für ein Benutzerformular ist, es sei denn, es sind zahlreiche Fehlerprüfungen enthalten.

um das zu erreichen, was Sie mit minimalen Änderungen an Ihrem Code tun müssen, gibt es zwei Ansätze.

1. Verwenden Sie KeyUp () event anstelle des Änderungsereignisses für das Textfeld. Hier ist ein Beispiel:

   Private Sub TextBox2_KeyUp(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
   
       Dim TextStr As String
       TextStr = TextBox2.Text
   
       If KeyCode <> 8 Then ' i.e. not a backspace
   
           If (Len(TextStr) = 2 Or Len(TextStr) = 5) Then
               TextStr = TextStr & "/"
           End If
   
       End If
       TextBox2.Text = TextStr
   End Sub
   

2. Wenn Sie das Change () -Ereignis verwenden möchten, verwenden Sie alternativ den folgenden Code. Dies ändert das Verhalten, so dass der Benutzer die Zahlen als eingeben muss 

   12072003
   

während das Ergebnis beim Tippen als erscheint

    12/07/2003

Das Zeichen '/' erscheint jedoch nur, wenn das erste Zeichen der DD, d. H. 0 von 07, eingegeben wurde. Nicht ideal, handhabt aber trotzdem Backspaces.

    Private Sub TextBox1_Change()
        Dim TextStr As String

        TextStr = TextBox1.Text

        If (Len(TextStr) = 3 And Mid(TextStr, 3, 1) <> "/") Then
            TextStr = Left(TextStr, 2) & "/" & Right(TextStr, 1)
        ElseIf (Len(TextStr) = 6 And Mid(TextStr, 6, 1) <> "/") Then
            TextStr = Left(TextStr, 5) & "/" & Right(TextStr, 1)
        End If

        TextBox1.Text = TextStr
    End Sub

Private Sub txtBoxBDayHim_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
If KeyAscii >= 48 And KeyAscii <= 57 Or KeyAscii = 8 Then 'only numbers and backspace
    If KeyAscii = 8 Then 'if backspace, ignores + "/"
    Else
        If txtBoxBDayHim.TextLength = 10 Then 'limit textbox to 10 characters
        KeyAscii = 0
        Else
            If txtBoxBDayHim.TextLength = 2 Or txtBoxBDayHim.TextLength = 5 Then 'adds / automatically
            txtBoxBDayHim.Text = txtBoxBDayHim.Text + "/"
            End If
        End If
    End If
Else
KeyAscii = 0
End If
End Sub

Das funktioniert für mich. :)

Ihr Code hat mir sehr geholfen. Vielen Dank!

Ich bin Brasilianer und mein Englisch ist schlecht, entschuldigen Sie jeden Fehler.