rendered paste bodyIf Target.Row > 4 Then
With Target.Cells(1, 1)
' == ввод даты в некоторые столбцы ==
If (.Column = 3 Or .Column = 7 Or Cells(4, .Column).Value = "дата") And VBA.CStr(.Value) <> "" Then
i = VBA.Replace(VBA.CStr(.Value), ",", ".")
i = VBA.Replace(i, " ", ".")
i = VBA.Replace(i, "/", ".")
i = VBA.Replace(i, "\", ".")
If 7 > VBA.Len(i) Then
' добавляем год
i = i + "." + VBA.CStr(Year(Now))
End If
On Error GoTo date_err
j = DateValue(i)
On Error Resume Next
d = Now
If d < j Then
MsgBox "Проверка даты: " + VBA.CStr(Day(j)) + "." + VBA.CStr(Month(j)) + "." + VBA.CStr(Year(j)) + vbCrLf + _
"раньше, чем сегодня: " + VBA.CStr(d) + "." + vbCrLf + vbCrLf + _
"События не должны происходить в Будущем." + vbCrLf + _
"Введите другую дату.", vbCritical
GoTo date_p_err
End If
If .Column = 3 Then
MsgBox "Проверка даты: " + VBA.CStr(Day(j)) + "." + VBA.CStr(Month(j)) + "." + VBA.CStr(Year(j)), vbInformation
Else
If j >= DateValue(Cells(.Row, 3).Value) Then
MsgBox "Проверка даты: " + VBA.CStr(Day(j)) + "." + VBA.CStr(Month(j)) + "." + VBA.CStr(Year(j)) + vbCrLf + _
"позже даты начала обучения: " + Cells(.Row, 3).Value + ".", vbInformation
If VBA.CStr(Cells(4, .Column + 1).Value) Like "*отчислен*" Then
Cells(.Row, .Column + 1).Value = ""
End If
Else
MsgBox "Проверка даты: " + VBA.CStr(Day(j)) + "." + VBA.CStr(Month(j)) + "." + VBA.CStr(Year(j)) + vbCrLf + _
"раньше даты начала обучения: " + Cells(.Row, 3).Value + "." + vbCrLf + vbCrLf + _
"События не должны происходить раньше Начала Обучения." + vbCrLf + _
"Введите другую дату.", vbCritical
GoTo date_p_err
End If
End If
.Value = i
End If
GoTo ok_date
date_err:
MsgBox "[ошибка 001] Невозможно распознать введённую дату: '" + i + "'." + vbCrLf + _
"Возможно неправильно введены числа, попробуйте ещё раз. Правильные примеры (число месяц): '01.02' или '02,03' или '04 04'." + vbCrLf + _
vbCrLf + _
"код системной ошибки:" + VBA.Str(err.Number) + vbCrLf + _
"описание: " + err.Description + " " + err.Source + vbCrLf + _
"Конец.", 16 + vbMsgBoxHelpButton, "Ошибка ввода даты", err.HelpFile, err.HelpContext
date_p_err:
.Value = ""
.Select
ok_date:
.........