在VBA的文本框中格式化MM / DD / YYYYdate

我正在寻找一种方法来自动将VBA文本框中的date格式化为MM / DD / YYYY格式，并且我希望格式化为用户input的格式。例如，一旦用户input第二个号码，程序会自动input“/”。 现在，我用下面的代码得到了这个工作（以及第二个短划线）： 

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

现在，这在打字时效果很好。 然而，当试图删除时，它仍然input破折号，所以用户不可能删除过去的一个破折号（删除破折号导致长度为2或5，然后再次运行该子，join另一个破折号）。 任何build议更好的方式来做到这一点？

我从来不build议使用文本框或input框来接受date。 很多事情可能会出错。 我甚至不能build议使用日历控件或dateselect器，因为你需要注册mscal.ocx或mscomct2.ocx，这是非常痛苦的，因为他们不是自由分配的文件。

这是我推荐的。 您可以使用此自定义日历来接受来自用户的date

PROS ：

  1. 您不必担心用户input错误的信息
  2. 您不必担心用户在文本框中粘贴
  3. 你不必担心写任何主要的代码
  4. 有吸引力的GUI
  5. 可以很容易地纳入您的应用程序
  6. 不要使用任何需要引用mscal.ocx或mscomct2.ocx等库的控件

缺点 ：

嗯…嗯…不能想到任何…

如何使用它

  1. 从这里下载Userform1.frm和Userform1.frx 。
  2. 在您的VBA中，只需导入Userform1.frm ，如下图所示。

导入表单

在这里输入图像描述

运行它

你可以在任何程序中调用它。 例如 

 Sub Sample() UserForm1.Show End Sub

屏幕在行动

在这里输入图像描述

这与Siddharth Rout的答案是一样的概念。 但是我想要一个可以完全自定义的dateselect器，这样外观和感觉可以适应任何项目的使用。

你可以点击这个链接下载我想出的自定义dateselect器。 以下是表格的一些截图。

三个例子日历

要使用dateselect器，只需将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)

这里有一些它包括的function的小味道。 所有选项都在userform模块本身中完整logging：

  • 使用方便。 用户表单是完全自包含的，可以导入到任何VBA项目中，并在没有太多的情况下使用（如果有任何附加的编码）。
  • 简单而有吸引力的devise
  • 完全可定制的function，尺寸和配色scheme
  • 将用户select限制在特定的date范围内
  • select一周中的第一天的任何一天
  • 包括周数，并支持ISO标准
  • 单击标题中的月份或年份标签可以显示可选的combobox
  • date在鼠标hover在上方时会变换颜色

添加一些东西来跟踪长度，并允许您检查用户是否添加或减less文本。 这是目前未经testing，但类似的东西应该工作（特别是如果你有一个用户表单）。 

 '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

为了好玩，我把Siddharth的build议放在单独的文本框中，做了combobox。 如果有人感兴趣，添加一个名为cboDay，cboMonth和cboYear的三个combobox的用户表单，并从左到右排列它们。 然后将下面的代码粘贴到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

您也可以在文本框上使用input掩码。 如果将掩码设置为##/##/####那么它将始终按照您input的格式进行格式化，除了检查input的内容是否为真实date之外，您不需要执行任何编码。

这只是一些简单的线路 

 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

为了快速解决，我通常这样做。

这种方法将允许用户在文本框中以任意格式inputdate，并在编辑完成后以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

不过，我想Sid开发的是一个更好的方法 – 一个完整的dateselect器控制。 

 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

这对我有用。 🙂

你的代码帮了我很多。 谢谢！

我是巴西人，我的英语很差，对不起任何错误感到抱歉。

虽然我同意以下答案中提到的内容，但build议对于用户窗体来说这是一个非常糟糕的devise，除非包括大量的错误检查。

要完成你需要做的事情， 只需对代码进行最less的修改 ，就有两种方法。

  1. 使用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 ' 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（）事件，请使用以下代码。 这改变了行为，所以用户不断input数字 

     12072003

而他打字的结果显示为 

  12/07/2003

但是只有当DD的第一个字符，即07的0被input时，才会出现“/”字符。 不理想，但仍然会处理退后。 

  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

我也是这样或那样的偶然遇到同样的困境，为什么Excel VBA没有Date Picker 。 感谢Sid，他为我们所有人创造了一个非常棒的工作。

尽pipe如此，我来到了需要创造自己的地步。 我在这里发布，因为我确信很多人都登陆这个post并从中受益。

我所做的事情非常简单，就像Sid所做的一样，只是我不使用临时工作表。 我以为计算非常简单直接，所以不需要把它转存到其他地方。 以下是日历的最终输出：

在这里输入图像描述

如何设置：

  • 创build42个Label控件，并按顺序将其命名，并从左到右，从上到下排列（这个标签包含从上面的灰色25到上面的灰色5 ）。 将Label控件的名称更改为Label_01 ， Label_02等。 将所有42个标签的Tag属性设置为dts 。
  • 为标题创build另外7个Label控件（这将包含Su，Mo，Tu … ）
  • 创build另外2个Label控件，一个用于水平线（高度设置为1），另一个用于月份和年份显示。 命名用于显示月份和年份Label_MthYr的Label
  • 插入2个Image控件，一个包含左侧图标滚动前几个月，一个滚动下个月（我更喜欢简单的左，右箭头图标）。 将其命名为Image_Left和Image_Right

布局应该或多或less像这样（我将创造力留给任何会使用这个的人）。

在这里输入图像描述

宣言：
我们需要在顶部声明一个variables来保存当前选定的月份。 

 Option Explicit Private curMonth As Date

私人程序和function： 

 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到Lable_42 ）
提示：build立前10个，只用剩余的查找和replace。 

 Private Sub Label_01_Click() select_label Me.Label_01 End Sub

这是为了hoverdate和点击效果。 

 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

用户窗体事件： 

 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

再次，只是为了hoverdate效应。 

 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

就是这样。 这是生的，你可以添加自己的扭曲。
我一直在使用这一段时间，我没有问题（性能和function明智）。
没有Error Handling ，但可以轻松pipe理我猜。
其实，没有这个效果，代码太短了。
你可以在select_label过程中pipe理你的date。 HTH。

Interesting Posts

一个或多个资源的目标是“头”，而不是“头”组件已经在视图中定义

graphics的DIFF程序的Linux

使JLabel通过设置最大宽度来包装它的文本

手编写的GUI与Qtdevise器GUI

如何testing片段视图对用户是否可见？

如何以编程方式移动UIScrollView以在键盘上方的控件中进行对焦？

CSS / HTML – dp（密度独立）单位？

在WinForms应用程序中自定义标题栏/ chrome

我怎样才能得到一个string资源AlertDialog中的可点击的超链接？

用户界面术语：login和login