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

Я ищу способ автоматического форматирования даты в текстовом поле VBA в формате MM / DD / YYYY, и я хочу, чтобы он форматировался, когда пользователь вводит его. Например, как только пользователь вводит второй номер, программа автоматически наберет «/». Теперь я получил эту работу (а также вторую тире) со следующим кодом:

Private Sub txtBoxBDayHim_Change() If txtBoxBDayHim.TextLength = 2 or txtBoxBDayHim.TextLength = 5 then txtBoxBDayHim.Text = txtBoxBDayHim.Text + "/" End Sub 

Теперь это отлично работает при наборе текста. Тем не менее, при попытке удалить он все еще входит в тире, поэтому его невозможно удалить из одной из тире (удаление тире приводит к длине 2 или 5, а потом снова запускается, добавив другой тире). Любые предложения по лучшему способу сделать это?

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

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

PROS :

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

CONS :

Уммм … Уммм … Не могу придумать …

КАК ЭТО ИСПОЛЬЗОВАТЬ

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

Импорт формы

введите описание изображения здесь

РАБОТАЮТ ЭТО

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

 Sub Sample() UserForm1.Show End Sub 

ЭКСКУРСИИ В ДЕЙСТВИИ

введите описание изображения здесь

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

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

Три примера календарей

Чтобы использовать средство выбора даты, просто импортируйте файл 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
  • Нажатие метки месяца или года в заголовке отображает выбранные поля со списком
  • Даты меняют цвет, когда вы наводите на них курсор

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

 '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 

Просто для удовольствия я принял предложение Сиддхарта о отдельных текстовых ящиках и сделал comboboxes. Если кому-то интересно, добавьте пользовательскую форму с тремя списками со списками 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 

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

Который всего несколько простых линий

 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 

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

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

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

введите описание изображения здесь

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

  • Создайте 42 элемента управления Label и назовите его последовательно и расположите слева направо, сверху вниз (эти метки содержат greyed 25 до greyed 5 выше). Измените имя элемента управления Label на Label_01 , Label_02 и т. Д. Задайте все свойства метки Tag 42 для dts .
  • Создайте еще 7 элементов управления Label для заголовка (это будет содержать Su, Mo, Tu … )
  • Создайте еще два Label управления 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 ярлык и должен быть сделан и в Image_Right управления 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_01Lable_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 . НТН.

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

Такой подход позволит пользователю вводить дату в любом формате, который им нравится в текстовом поле, и, наконец, форматировать в формате 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 

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

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

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

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

     Private Sub TextBox2_KeyUp(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer) Dim TextStr As String TextStr = TextBox2.Text If KeyCode <> 8 Then ' ie not a backspace If (Len(TextStr) = 2 Or Len(TextStr) = 5) Then TextStr = TextStr & "/" End If End If TextBox2.Text = TextStr End Sub 
  2. В качестве альтернативы, если вам нужно использовать событие Change () , используйте следующий код. Это изменяет поведение, поэтому пользователь продолжает вводить числа, так как

     12072003 

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

  12/07/2003 

Но символ «/» появляется только после ввода первого символа DD, т.е. 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 
 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 

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

Ваш код мне очень помог. Благодаря!

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

  • Выберите все содержимое текстового поля, когда он получает фокус (Vanilla JS или jQuery)
  • Qt сигнализирует по streamам, один - stream GUI?
  • Более эффективный способ обновления пользовательского интерфейса от службы, чем намерения?
  • Простая всплывающая форма java с по меньшей мере двумя полями
  • Переместить макеты, когда отображается мягкая клавиатура?
  • Установка свойства Style метки WPF в коде?
  • Разница между validate (), revalidate () и invalidate () в графическом интерфейсе Swing
  • Как создать приложение C ++ / CLI Winforms в VS2012?
  • Удалить границу нижней границы в панели вкладок? (И изменить выбранный цвет)
  • Доступ к компонентам GUI из другого classа
  • Использование нескольких JFrames: хорошая или плохая практика?
  • Давайте будем гением компьютера.