在文本框中插入日期-VBA

我对您正在处理的日历表单还不够熟悉，因此请理解我基于西式日历的示例。

您执行某些错误检查的方式会使您检查的值有些模糊。例如，

If Mid(TextBox1.Value, 6, 2) = 0 Or Mid(TextBox1.Value, 6, 2) > 12 Then

是完全有效的检查，但是您过度使用了该Mid功能。一种建议是解析日期字符串，然后将子字符串拉出您要查找的值。如：

Dim month As Long
month = CLng(Mid$(TextBox1.Value, 6, 2))
If (month = 0) Or (month > 12) Then

这更直观。是的，它创建了一个额外的变量，但它使您的代码更具可读性。

这是我的代码（未经测试的）版本，作为如何完成代码的另一个示例。注意，我将错误检查分为一个单独的函数，因为它涉及更多。（这样就不会使主例程变得混乱。）

编辑：答案已经更新和测试。更改了事件代码TextBox1_Change，现在捕获了两个不同的事件：LostFocus和KeyDown，以便在用户单击文本框或文本框内的类型Enter时启动验证。

Option Explicit

Private Enum ValidationError
    LengthError
    FormatError
    YearError
    MonthError
    DayError
    NoErrors
End Enum

Private Sub TextBox1_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, _
                             ByVal Shift As Integer)
    If KeyCode = Asc(vbCr) Then
        ValidateDate
    End If
End Sub

Private Sub TextBox1_LostFocus()
    ValidateDate
End Sub

Private Sub ValidateDate()
    With TextBox1
        Select Case InputIsValidated(.text)
            Case LengthError
                MsgBox "Please insert date with format: YYYYMMDD or YYYY/MM/DD with only numbers and a '/'"
            Case FormatError
                MsgBox "Please insert date with format: YYYYMMDD or YYYY/MM/DD with only numbers and a '/'"
            Case YearError
                .SelStart = 0
                .SelLength = 4
                MsgBox "Invalid Year. Must be between 2015 and 2020"
            Case MonthError
                .SelStart = 5
                .SelLength = 2
                MsgBox "Invalid Month. Must be between 1 and 12"
            Case DayError
                .SelStart = 7
                .SelLength = 2
                MsgBox "Invalid Day. Must be between 1 and 31"
            Case NoErrors
                '--- nothing to do, it's good!
                MsgBox "It's good!"
        End Select
    End With
End Sub

Private Function InputIsValidated(ByRef text As String) As ValidationError
    '--- perform all sorts of checks to validate the input
    '    before any processing
    '--- MUST be the correct length
    If (Len(text) <> 8) And (Len(text) <> 10) Then
        InputIsValidated = LengthError
        Exit Function
    End If

    '--- check if all characters are numbers
    Dim onlyNumbers As String
    onlyNumbers = Replace(text, "/", "")
    If Not IsNumeric(onlyNumbers) Then
        InputIsValidated = FormatError
        Exit Function
    End If

    Dim yyyy As Long
    Dim mm As Long
    Dim dd As Long
    yyyy = Left$(onlyNumbers, 4)
    mm = Mid$(onlyNumbers, 5, 2)
    dd = Right$(onlyNumbers, 2)

    '--- only checks if the numbers are in range
    '    you can make this more involved if you want to check
    '    if, for example, the day for February is between 1-28
    If (yyyy < 2015) Or (yyyy > 2020) Then
        InputIsValidated = YearError
        Exit Function
    End If

    If (mm < 1) Or (mm > 12) Then
        InputIsValidated = MonthError
        Exit Function
    End If

    If (dd < 1) Or (dd > 31) Then
        InputIsValidated = DayError
        Exit Function
    End If

    text = onlyNumbers
    InputIsValidated = NoErrors
End Function