All pastes #1916033 Raw Edit

ms excel: support for user input

public text v1 · immutable
#1916033 ·published 2010-08-12 21:25 UTC
rendered paste body
If 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:

.........