проверка вводимых значений

[nik1905]

есть userform с четыренмя полями:
договор
дата договора
контрагент
сумма договора
необходимо реализовать проверку корректности вводимых данных
дата - дата
договор и конрагент - строка
сумма договора - число

подскажите, пожалуйста как это реализвать

вот мой код:

Function proverka(tempstr As String) As Integer

Dim temp As String

proverka = 0
temp = tempstr

If temp <> "" Then
proverka = 1
Else
MsgBox "Некорректный ввод данных!", vbExclamation, "Error"
End If

End Function
Function proverka_dat(str As String) As Integer

Dim temp As String

proverka_dat = 0

temp = str

If IsDate(temp) Then
proverka_dat = 1
Else
Select Case temp
Case ""
MsgBox "Необходимо ввести дату!", vbExclamation, "Error"
Case Else
MsgBox "Некорректная дата!", vbExclamation, "Error"
End Select
End If
End Function

Private Sub OK_Click()

Dim n As Integer

Dim dok As String
Dim dat As String
Dim kon As String
Dim sum As String

Dim doki As Integer
Dim dati As Integer
Dim koni As Integer
Dim sumi As Integer

n = Range("A1").CurrentRegion.Rows.Coun t

met1:

dok = txtDok.Value
doki = proverka(dok)
If doki = 1 Then
Cells(n + 6, 3) = txtDok.Value
Else
GoTo met1
End If

dat = txtDat.Value
dati = proverka_dat(dat)
If dati = 1 Then
Cells(n + 7, 3) = txtDat.Value
Else
GoTo met1
End If


kon = txtKon.Value
koni = proverka(kon)
If koni = 1 Then
Cells(n + 8, 3) = txtKon.Value
Else
GoTo met1
End If


sum = txtSum.Value
sumi = proverka(sum)
If sumi = 1 Then
Cells(n + 9, 3) = txtSum.Value
Else
GoTo met1
End If

position.Hide

End Sub

Помогите, очень надо!!!!
Спасибо

[EducatedFool]

А что конкретно не получается?

PS: Код можно немного сократить:

Function proverka(tempstr As String) As Integer
    If Len(tempstr) Then proverka = 1 Else MsgBox "Некорректный ввод данных!", vbExclamation, "Error"
End Function

Function proverka_dat(str As String) As Integer
    If IsDate(str) Then
        proverka_dat = 1
    Else
        MsgBox IIf(Len(str), "Некорректная дата!", "Необходимо ввести дату!"), vbExclamation, "Error"
    End If
End Function

[nik1905]

зацикливается и не дает исправить незаполненные или неправильно заполненные поля... что типа: 12,01,01 если через запятые, то выскакивает окошко: "некорректная дата", но не дает возможности сделать исправления, вот в этом проблема!! тоже самое относительно пустых полей, после вывода ошибки необходима возможность ее исправления! подскажите, как решить?

[nik1905]

может быть надо писать для каждого поля в отдельном subе для окошечка? и туда же засовывать проверку? или можно как-то изменить логику в предлагаемом коде?

[EducatedFool]

но не дает возможности сделать исправления, вот в этом проблема!

Нет ни малейшего желания воссоздавать Вашу форму для проверки кода.

Будет файл с формой - будет и решение.

[nik1905]

вот, посмотрите, пожалуйста!

[EducatedFool]

Попробуйте такой вариант:


Кнопка ОК будет недоступна, если в поля введены не все (или введены некорректные) значения.

Вот весь код:

Private Sub B_Дата1_Change_Click()
    Me.Date1 = Format(Get_Date(Me.Date1, Now), "DD-MM-YYYY")
End Sub

Private Sub B_Дата2_Change_Click()
    Me.Date2 = Format(Get_Date(Me.Date2, Now), "DD-MM-YYYY")
End Sub

Private Sub Date1_Change(): Проверка: End Sub
Private Sub Date2_Change(): Проверка: End Sub
Private Sub txtFIO_Change(): Проверка: End Sub
Private Sub txtDok_Change(): Проверка: End Sub
Private Sub txtKon_Change(): Проверка: End Sub
Private Sub txtSum_Change(): Проверка: End Sub

Sub Проверка()
    ДатыВведены = IsDate(Date1) And IsDate(Date2)
    ПоляЗаполнены = Len(Trim(txtFIO)) > 3 And IsNumeric(txtDok) And Len(Trim(txtKon)) > 3 And IsNumeric(txtSum)
    Me.OK.Enabled = ДатыВведены And ПоляЗаполнены
End Sub

Private Sub UserForm_Initialize()
    Me.Date1 = Format(Now - 2, "DD-MM-YYYY")
    Me.Date2 = Format(Now, "DD-MM-YYYY")
End Sub

Private Sub OK_Click()
    [c5] = Me.Date1: [c6] = txtFIO: [c9] = txtDok: [c8] = Me.Date2
    [c10] = txtKon: [c11] = txtSum
    Unload Me
End Sub

[nik1905]

Спасибо за помощь!!! Буду разбираться...