任务表格的日期向我们显示格式，除非不存在日期

Question

我使用Excel的表单功能有一个小的用户界面，该功能允许用户输入项目的开始和完成日期。

如果用户列出了美国和英国格式可用的日期(例如2018年5月7日，2018年5月7日(，则变量将以美国格式发布(例如，2018年7月5日，5/7/7//7/2018(。但是，如果两种格式都不可用(例如2018年8月31日，2018年8月31日(，则该变量将以(正确的(英国格式返回。

我目前对表单中特定变量的代码如下：

Private Sub Calculate_Click()
    sDate = CDate(sDate.Text)
    eDate = CDate(eDate.Text)
    If sDate = vbNullString Then
        sDate = Now()
    End If
    If eDate = vbNullString Then
        eDate = Now() + 40
    End If
    If HoursPD = vbNullString Then
        HoursPD = 6
    ElseIf HoursPD > 7.5 Then
        HoursPD = 7.5
    End If
    Me.Hide
End Sub

有什么方法可以确保变量格式已固定在英国版本？

Answer 1

我会使用单独的过程检查表格上的任何日期。
如果输入了非valid日期，则它也会为控制红色染色。
将日期格式化为dd-mmm-yyyy，使以错误格式的日期更容易，因为一个月写了(ish(。

Public Sub FormatDate(ctrl As Control)
    Dim dDate As Date
    Dim IsDate As Boolean
    On Error GoTo ERR_HANDLE
    If Replace(ctrl.Value, " ", "") <> "" Then
        On Error Resume Next
            dDate = CDate(ctrl.Value)
            IsDate = (Err.Number = 0)
            On Error GoTo 0
        On Error GoTo ERR_HANDLE
        If IsDate Then
            ctrl.Value = Format(ctrl.Value, "dd-mmm-yyyy")
            ctrl.BackColor = RGB(255, 255, 255)
        Else
            ctrl.BackColor = RGB(255, 0, 0)
        End If
    End If
EXIT_PROC:
        On Error GoTo 0
        Exit Sub
ERR_HANDLE:
        'Error Handling routines.
        'DisplayError Err.Number, Err.Description, "mdl_FormatDate.FormatDate()"
        Resume EXIT_PROC
End Sub  

然后在控件的AfterUpdate事件中调用：

Private Sub txtDate_AfterUpdate()
    On Error GoTo ERR_HANDLE
    With Me
        FormatDate .txtDate
    End With
EXIT_PROC:
        On Error GoTo 0
        Exit Sub
ERR_HANDLE:
        'Error Handling routines.
        'DisplayError Err.Number, Err.Description, "Data_Entry_Form.txtDate_AfterUpdate()"
        Resume EXIT_PROC
End Sub

Answer 2

您可以做以下类似的操作，但是您的用户应该知道以正确(英国(格式输入日期：

    sDate = Format(CDate(sDate.Text), "dd/mm/yyyy")
    EDate = Format(CDate(EDate.Text), "dd/mm/yyyy")