文本框日期格式excel vba

时间:2017-01-19 06:52:38

标签: excel vba excel-vba

我有一个代码,允许我在textbox1中手动输入日期,然后在useform的日历中选择日期。还有第二个文本框允许我添加或减去日期。代码完美无缺。

用户形式代码 -

Option Explicit 
Private Sub TextBox1_Exit(ByVal Cancel As MSForms.ReturnBoolean) 
    If IsDate(Me.TextBox1.Value) Then Me.Calendar1.Value = Me.TextBox1.Value 
End Sub 
Private Sub TextBox2_Exit(ByVal Cancel As MSForms.ReturnBoolean) 
    Dim dt As Date 
    With Me 
        If IsDate(.TextBox1.Value) Then 
            dt = CDate(.TextBox1.Value) + Val(.TextBox2.Value)
            .TextBox1.Value = dt 
            .Calendar1.Value = dt
        End If 
    End With 
End Sub 

我想以特定格式在textbox1中手动输入日期。

格式为 -

DD

DDMMM

ddmmmyyy

我不确定如何编写执行此操作的代码。

我们的想法是在textbox1中以上面指定的3种格式之一输入日期,然后在用户表单的日历上选择该日期。

1 个答案:

答案 0 :(得分:0)

在对有关允许的格式的澄清之后

已编辑

您可以构建以下代码

Option Explicit

Private Sub TextBox1_Exit(ByVal Cancel As MSForms.ReturnBoolean)
    Dim txt As String, dayStr As String, monthStr As String, yearStr As String
    Dim okTxt As Boolean

    txt = Me.TextBox1.Value
    Select Case Len(txt)
        Case 2
            dayStr = txt
            okTxt = okDay(dayStr)
            monthStr = month(Now)
            yearStr = year(Now)
        Case 5
            dayStr = Mid(txt, 3, 3)
            monthStr = Mid(txt, 3, 3)
            okTxt = okDay(Left(txt, 2)) And okMonth(monthStr)
            yearStr = year(Now)
        Case 7
            dayStr = Mid(txt, 3, 3)
            monthStr = Mid(txt, 3, 3)
            yearStr = Mid(txt, 6, 2)
            okTxt = okDay(Left(txt, 2)) And okMonth(monthStr) And okYear(yearStr)
    End Select
    If Not okTxt Then
        MsgBox "Invalid date" _
               & vbCrLf & vbCrLf & "Date must be input in one of the following formats:" _
               & vbCrLf & vbTab & "dd" _
               & vbCrLf & vbTab & "ddmmm" _
               & vbCrLf & vbTab & "ddmmmyy" _
               & vbCrLf & vbCrLf & "Please try again", vbCritical

        Cancel = True
    Else
        Me.Calendar1.Value = CDate(Left(txt, 2) & " " & monthStr & " " & yearStr)
    End If
End Sub

Function okDay(txt As String) As Boolean
    okDay = CInt(txt) > 0 And CInt(txt) < 31
End Function

Function okMonth(txt As String) As Boolean
    Const months As String = "JANFEBMARAPRMAJJUNJULAUGSEPOCTNOVDEC"
    okMonth = InStr(months, UCase(txt)) > 0
End Function

Function okYear(txt As String) As Boolean
    okYear = CInt(txt) > 0 And CInt(txt) < 200 '<--| set your "limit" years
End Function