Я пытаюсь проверить текстовое поле в VBA, чтобы пользователь не мог вводить значения, которые не могли бы оказаться датой в течение некоторого интервала.Есть ли смысл определить, может ли строка быть префиксом даты с некоторым интервалом?Например, если пользователю необходимо ввести дату между 01.01.2008 и 31.12.2017, я хочу пропустить «02/20», но не что-то вроде «29/29».Даты могут быть в формате мм / дд / гггг или дд / мм / гггг, хотя я выберу хороший алгоритм только для одного из форматов.Я не уверен в способе сделать это без большого количества циклов или условий.
Редактировать: Я думаю, что нашел хорошее решение, если кто-то хочет проверить это.
Private Sub mMainControl_Change()
Dim vIsValid As Boolean
Dim vPrefixLength As Integer
Dim vDatePrefix As String
vDatePrefix = CStr(mMainControl.Value)
vPrefixLength = Len(vDatePrefix)
If vPrefixLength = 0 Then
Exit Sub
ElseIf Not InitialCheck(vDatePrefix, mMinValue, mMaxValue) Then
vIsValid = False
ElseIf mMaxValue - mMinValue > 365 Then
If Not FullYearCheck(vDatePrefix, mMinValue, mMaxValue) Then vIsValid = False
Else
If Not PartYearCheck(vDatePrefix, mMinValue, mMaxValue) Then vIsValid = False
End If
If Not vIsValid Then mMainControl.Value = Left(vDatePrefix, Min(10, vPrefixLength - 1))
End Sub
Private Function InitialCheck(ByVal DatePrefix As String, ByVal MinDate As Date, ByVal MaxDate As Date) As Boolean
Dim vPrefixLength As Integer
Dim vTestDate As Variant
vPrefixLength = Len(DatePrefix)
If vPrefixLength > 10 Or Not DatePrefix Like Left("##/##/####", vPrefixLength) Then
InitialCheck = False
Exit Function
End If
On Error Resume Next
vTestDate = CDate(DatePrefix & Right("01/01/1996", 10 - vPrefixLength))
vTestDate = CDate(DatePrefix & Right("01/00/1984", 10 - vPrefixLength))
On Error GoTo 0
InitialCheck = Not IsEmpty(vTestDate)
End Function
Private Function FullYearCheck(ByVal DatePrefix As String, ByVal MinDate As Date, ByVal MaxDate As Date) As Boolean
Dim i As Integer, vPrefixLength As Integer, vMinPrefixYear As Integer, vMaxPrefixYear As Integer
Dim vFullDate As Variant
vPrefixLength = Len(DatePrefix)
If vPrefixLength > 6 Then
vMinPrefixYear = CInt(Right(DatePrefix, vPrefixLength - 6) & Left("0000", 10 - vPrefixLength))
vMaxPrefixYear = CInt(Right(DatePrefix, vPrefixLength - 6) & Left("9999", 10 - vPrefixLength))
If Year(MinDate) < vMinPrefixYear Then MinDate = DateSerial(vMinPrefixYear, 1, 1)
If Year(MaxDate) > vMaxPrefixYear Then MaxDate = DateSerial(vMaxPrefixYear, 12, 31)
End If
For i = 0 To Year(MaxDate) - Year(MinDate)
vFullDate = DatePrefix & Right("01/01/" & CStr(Year(MinDate) + i), 10 - vPrefixLength)
If ValidByMonth(vFullDate, MinDate, MaxDate) Or ValidByDay(vFullDate, MinDate, MaxDate) Then Exit For
vFullDate = DatePrefix & Right("01/00/" & CStr(Year(MinDate) + i), 10 - vPrefixLength)
If ValidByMonth(vFullDate, MinDate, MaxDate) Or ValidByDay(vFullDate, MinDate, MaxDate) Then Exit For Else vFullDate = Empty
Next i
FullYearCheck = Not IsEmpty(vFullDate)
End Function
Private Function PartYearCheck(ByVal DatePrefix As String, ByVal MinDate As Date, ByVal MaxDate As Date) As Boolean
Dim i As Integer, vPrefixLength As Integer
Dim vFullDate As Variant
vPrefixLength = Len(DatePrefix)
For i = 0 To MaxDate - MinDate
vFullDate = DatePrefix & Right(Format(CStr(MinDate + i), "mm/dd/yyyy"), 10 - vPrefixLength)
If ValidByMonth(vFullDate, MinDate, MaxDate) Then Exit For
vFullDate = DatePrefix & Right(Format(CStr(MinDate + i), "dd/mm/yyyy"), 10 - vPrefixLength)
If ValidByDay(vFullDate, MinDate, MaxDate) Then Exit For Else vFullDate = Empty
Next i
PartYearCheck = Not IsEmpty(vFullDate)
End Function
Private Function ValidByMonth(ByVal DateString As String, ByVal MinDate As Date, ByVal MaxDate As Date) As Boolean
Dim vTestDate As Variant
On Error Resume Next
vTestDate = CDate(MonthName(Left(DateString, 2)) & " " & Mid(DateString, 4, 2) & ", " & Right(DateString, 4))
If vTestDate < MinDate Or vTestDate > MaxDate Then vTestDate = Empty
On Error GoTo 0
ValidByMonth = Not IsEmpty(vTestDate)
End Function
Private Function ValidByDay(ByVal DateString As String, ByVal MinDate As Date, ByVal MaxDate As Date) As Boolean
Dim vTestDate As Variant
On Error Resume Next
vTestDate = CDate(MonthName(Mid(DateString, 4, 2)) & " " & Left(DateString, 2) & ", " & Right(DateString, 4))
If vTestDate < MinDate Or vTestDate > MaxDate Then vTestDate = Empty
On Error GoTo 0
ValidByDay = Not IsEmpty(vTestDate)
End Function