Форматирование даты MM/DD/YYYY в текстовом поле в VBA

Ответ 1

Я никогда не предлагаю использовать текстовые поля или поля ввода для принятия даты. Так много вещей может пойти не так. Я даже не могу предложить использовать элемент управления Calendar или Date Picker, так как для этого вам нужно зарегистрировать mscal.ocx или mscomct2.ocx, и это очень болезненно, поскольку они не являются свободно распространяемыми файлами.

Вот что я рекомендую. Вы можете использовать этот пользовательский календарь, чтобы принимать даты от пользователя

ПРОФИ:

1. Вам не нужно беспокоиться о вводе пользователем неправильной информации
2. Вам не нужно беспокоиться о вставке пользователем в текстовое поле
3. Вам не нужно беспокоиться о написании какого-либо основного кода
4. Привлекательный графический интерфейс
5. Может быть легко включен в ваше приложение
6. Не использует элементы управления, для которых вам нужно ссылаться на какие-либо библиотеки, такие как mscal.ocx или mscomct2.ocx

МИНУСЫ:

Ммм... Ммм... Не могу думать ни о чем...

КАК ЭТО ИСПОЛЬЗОВАТЬ (Файл отсутствует в моем Dropbox. Пожалуйста, обратитесь к нижней части поста за обновленной версией календаря)

1. Загрузите Userform1.frm и Userform1.frx из здесь.
2. В свой VBA просто импортируйте Userform1.frm, как показано на рисунке ниже.

Импорт формы

РАБОТАЕТ ЭТО

Вы можете вызвать это в любой процедуре. Например,

Sub Sample()
    UserForm1.Show
End Sub

ЭКРАН РАБОТАЕТ В ДЕЙСТВИИ

ПРИМЕЧАНИЕ: вы также можете захотеть увидеть перевод Календаря на новый уровень

Ответ 2

Это та же концепция, что и ответ Siddharth Rout. Но мне нужен был сборщик дат, который можно было бы полностью настроить, чтобы внешний вид и внешний вид могли быть адаптированы к любому проекту, в котором он используется.

Вы можете щелкнуть эту ссылку, чтобы загрузить пользовательскую подборку дат, с которой я пришел. Ниже приведены скриншоты формы в действии.

Чтобы использовать средство выбора даты, просто импортируйте файл CalendarForm.frm в свой проект VBA. Каждый из приведенных выше календарей может быть получен с помощью одного вызова функции. Результат зависит только от используемых вами аргументов (все они являются необязательными), поэтому вы можете настроить его как можно больше или меньше.

Например, самый базовый календарь слева может быть получен следующей строкой кода:

MyDateVariable = CalendarForm.GetDate

Вот и все. Оттуда вы просто включаете какие-либо аргументы, которые вы хотите получить, календар вы хотите. Вызов функции ниже приведет к созданию зеленого календаря справа:

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)

Вот небольшой вкус некоторых функций, которые он включает. Все параметры полностью задокументированы в самом модуле пользовательской формы:

• Простота использования. Пользовательская форма полностью автономна и может быть импортирована в любой проект VBA и используется без особого дополнительного кодирования.
• Простой, привлекательный дизайн.
• Полностью настраиваемая функциональность, размер и цветовая схема.
• Ограничить выбор пользователя до определенного диапазона дат
• Выберите любой день в течение первого дня недели.
• Включить номера недель и поддержку стандарта ISO
• Нажав метку месяца или года в заголовке, вы увидите выбранные поля со списком
• Даты меняют цвет при наведении указателя мыши на них

Ответ 3

Добавьте что-нибудь, чтобы отследить длину и позволить вам выполнять "проверки" на том, добавляет ли пользователь или вычитает текст. В настоящее время это не проверено, но что-то похожее на это должно работать (особенно если у вас есть пользовательская форма).

'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

Ответ 4

Я тоже так или иначе наткнулся на ту же дилемму, почему в Excel VBA нет Date Picker. Спасибо Сиду, который сделал огромную работу, чтобы создать что-то для всех нас.

Тем не менее, я пришел к тому моменту, когда мне нужно было создать свою собственную. И я отправляю его здесь, так как многие люди, которых я уверен, приземляются на этот пост и получаю от него выгоду.

То, что я делал, было очень просто, как то, что делает Сид, за исключением того, что я не использую временный лист. Я думал, что вычисления очень просты и прямолинейны, поэтому нет необходимости сбрасывать их где-то в другом месте. Здесь конечный результат календаря:

Как настроить:

• Создайте 42 Label элементы управления и назовите его последовательно и расположите слева направо, сверху вниз (эти метки содержат greyed 25 до greyed 5 выше). Измените имя элементов управления Label на Label_01, Label_02 и т.д. Установите для всех 42 меток Tag значение dts.
• Создайте еще 7 элементов управления Label для заголовка (это будет содержать Su, Mo, Tu...)
• Создайте еще 2 элемента управления Label, один для горизонтальной линии (высота - 1) и один для отображения месяца и года. Назовите Label, используемый для отображения месяца и года Label_MthYr
• Вставьте 2 Image элементы управления, один из которых должен содержать левый значок для прокрутки предыдущих месяцев и один для прокрутки в следующем месяце (я предпочитаю простой значок стрелки влево и вправо). Назовите его Image_Left и Image_Right

Макет должен быть более или менее подобным (я оставляю творчество любому, кто будет его использовать).

Декларация:. Нам нужна одна переменная, объявленная в самом верхнем, чтобы выделить текущий месяц.

Option Explicit
Private curMonth As Date

Частная процедура и функции:

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

События изображения:

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

Я добавил это, чтобы он выглядел так, как пользователь щелкает ярлык и должен выполняться также в элементе управления Image_Right.

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

Ярлыки:
Все это должно быть сделано для всех 42 меток (Label_01 to Lable_42)
Совет. Создайте первый 10 и просто используйте find и replace для остальных.

Private Sub Label_01_Click()
    select_label Me.Label_01
End Sub

Это для зависания дат и эффекта нажатия.

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:

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

Опять же, для эффекта зависания даты.

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

И что это. Это сырье, и вы можете добавить к нему свой собственный поворот.
Я использую это некоторое время, и у меня нет проблем (производительность и функциональность мудрый).
Нет Error Handling, но можно легко управлять. Думаю. На самом деле, без эффектов код слишком короткий,
Вы можете управлять тем, где ваши даты идут в процедуре select_label. НТН.

Ответ 5

Просто для удовольствия я взял предложение Сиддхарта из отдельных текстовых полей и сделал comboboxes. Если кто-то заинтересован, добавьте пользовательскую форму с тремя списками combboox cboDay, cboMonth и cboYear и разместите их слева направо. Затем вставьте код ниже в модуль кода UserForm. Необходимые свойства combobox задаются в UserFormInitialization, поэтому дополнительная подготовка не требуется.

Сложная часть меняет день, когда он становится недействительным из-за изменения года или месяца. Этот код просто сбрасывает его до 01, когда это происходит, и выделяет cboDay.

Я не кодировал ничего подобного. Надеюсь, это кому-то будет интересно, когда-нибудь. Если бы не было весело!

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

Ответ 6

Для быстрого решения я обычно делаю это.

Этот подход позволит пользователю вводить дату в любом формате, который им нравится в текстовом поле, и, наконец, форматировать в формате mm/dd/yyyy, когда он будет выполнен. Поэтому он довольно гибкий:

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

Однако, я думаю, что разработанный Сид - гораздо лучший подход - полноценный контроль выбора даты.

Ответ 7

Вы также можете использовать маску ввода в текстовом поле. Если вы установите маску на ##/##/####, она всегда будет отформатирована по мере ввода, и вам не нужно делать какие-либо кодировки, кроме проверки, чтобы определить, была ли введенная дата.

Какая всего несколько простых строк

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

Ответ 8

В то время как я согласен с тем, что упоминается в ответах ниже, предлагая, что это очень плохой дизайн для Userform, если не включены многочисленные проверки ошибок...

чтобы выполнить то, что вам нужно сделать, с минимальными изменениями в вашем коде, есть два подхода.

• Используйте событие KeyUp() вместо изменения для текстового поля. Вот пример:

  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
  

• В качестве альтернативы, если вам нужно использовать событие Изменить(), используйте следующий код. Это изменяет поведение, поэтому пользователь продолжает вводить числа, поскольку

  12072003
  

в то время как результат, когда он печатает, выглядит как

    12/07/2003

Но символ '/' появляется только после ввода первого символа DD i.e 0 из 07. Не идеально, но все равно будет обрабатывать промежутки.

    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

Ответ 9

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

Это работает для меня.:)

Ваш код мне очень помог. Спасибо!

Я бразильский, и мой английский плохой, извините за любую ошибку.