在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.frmUserform1.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_01Label_02等。 将所有42个标签的Tag属性设置为dts
  • 为标题创build另外7个Label控件(这将包含Su,Mo,Tu …
  • 创build另外2个Label控件,一个用于水平线(高度设置为1),另一个用于月份和年份显示。 命名用于显示月份和年份Label_MthYrLabel
  • 插入2个Image控件,一个包含左侧图标滚动前几个月,一个滚动下个月(我更喜欢简单的左,右箭头图标)。 将其命名为Image_LeftImage_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_01Lable_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。