Проверка строки на правильность данных

[haros]

Всем привет!
Такая проблемка:
Нужно сделать такую проверку на правильность перед вставкой данных из формы в таблицу (добавляться должно Ф.И.О):
1. Строка должна состоять из русских букв, "-" (для двойных фамилий) и ' (для фамилий типа Д'Артаньян)
2. Фамилия Имя Отчество должны быть разделены 1 пробелом и начинаться с заглавной буквы.

Как сделать проверку на соответствие моим требованиям максимально компактной, а то тупой перебор с помощью команд типа:
If CStr(fio.Text) Like "*[A-Z]*" не есть гут.

Прошу помощи, у самого уже моск кипит

[viter.alex]

Нужно использовать регулярные выражения.
Как? Здесь написано.
В вашем случае строка должна соответсвовать чему-то такому
<[А-ЯЁ][а-яё]@> — это шаблон для фамилии.
<[А-ЯЁ][а-яё]@>-<[А-ЯЁ][а-яё]@> — это для фамилии с дефисом
<[А-ЯЁ][а-яё]@> — это для имени и отчества.
Общий шаблон такой
<[А-ЯЁ][а-яё]@>^0032{1}<[А-ЯЁ][а-яё]@>^0032{1}<[А-ЯЁ][а-яё]@>
Т.е. фамилия, имя, отчество через один пробел. Все слова должны быть с большой буквы. Что непонятно, спрашивай.

[EducatedFool]

Добавьте в код формы такой код:

Private Sub FIO_Change()
    txt = LTrim$(Me.FIO): txt = StrConv(txt, vbProperCase): txt = Replace(txt, "  ", " ")
    If txt <> Me.FIO Then Me.FIO = txt
End Sub

Private Sub FIO_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
    Select Case KeyAscii
        Case 32, 45, 39, 96, 1040 To 1105    ': DoEvents
        Case Else: KeyAscii = 0
    End Select
End Sub

Этот код не позволит вводить символы, кроме апострофа, минуса(тире) и русских букв в поле ввода FIO.

Кроме того, код автоматически вырезает повторяющиеся пробелы из поля, и делает заглавными первые буквы всех слов в поле.

PS: В фамилиях и именах могут содержаться цифры и спецсимволы - ЗАГСы уже давно начали регистрировать имена типа 123@mail.ru

[haros]

Всем спасибо!
to viter.alex: реально незнал что в vba есть регулярные выражения! полезная инфа.

to EducatedFool: код работает, но можно для новичка немного пояснений по принципу работу процедур?

[EducatedFool]

Немного комментариев:

Private Sub FIO_Change()
    ' срабатывает при изменении содержимого поля ввода

    txt = LTrim$(Me.FIO)    ' считывает в переменную текст из поля, сразу убирая пробелы слева
    txt = StrConv(txt, vbProperCase)    ' делаем первые символы слов заглавными
    txt = Replace(txt, "  ", " ")    ' заменяем двойные пробелы одинарными

    If txt <> Me.FIO Then Me.FIO = txt    ' если обработанный текст отличается от находящегося в поле ввода
    ' то записываем обработанный текст в поле (заменяя то, что там было)
End Sub


Private Sub FIO_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
    ' срабатывает при вводе в поле любого символа

    Select Case KeyAscii    ' проверяем значение кода символа
        Case 32, 45, 39, 96, 1040 To 1105    ' если это код пробела (32), апострофа (39 или 96),
            ' дефиса (45) или русской буквы в любом регистре (от 1040 до 1105),
            ' то ничего не делаем

        Case Else: KeyAscii = 0    ' иначе сбрасываем код символа (отменяем его ввод)
    End Select
End Sub

[haros]

Огромное тебе, человеческое спасибо!

[viter.alex]

Я немного погорячился. Те шаблоны, это шаблоны поиска в Word. Для RegEx это немного сложнее, но тоже решаемо. Например, вот так. Я пока не сообразил, как это сделать через одно выражение.

Sub testname()
  Dim objRegExp As Object, sName As String, bRes As Boolean
  bRes = False: sName = "Соловьев-Седой Василий Иванович"
  Set objRegExp = CreateObject("VBScript.RegExp")
  If Not bRes Then
    objRegExp.Pattern = "^[А-ЯЁ]{1}[а-яё]{0,}\s[А-ЯЁ]{1}[а-яё]{0,}\s[А-ЯЁ]{1}[а-яё]{0,}"
    bRes = objRegExp.test(sName)
    If Not bRes Then
      objRegExp.Pattern = "^[А-ЯЁ]{1}[а-яё]{0,}'[А-ЯЁ]{1}[а-яё]{0,}\s[А-ЯЁ]{1}[а-яё]{0,}\s[А-ЯЁ]{1}[а-яё]{0,}"
      bRes = objRegExp.test(sName)
      If Not bRes Then
        objRegExp.Pattern = "^[А-ЯЁ]{1}[а-яё]{0,}-[А-ЯЁ]{1}[а-яё]{0,}\s[А-ЯЁ]{1}[а-яё]{0,}\s[А-ЯЁ]{1}[а-яё]{0,}"
        bRes = objRegExp.test(sName)
      End If
    End If
  End If
  If bRes Then
    MsgBox "Имя " & sName & " соответствует шаблону " & objRegExp.Pattern
  Else
    MsgBox "Имя " & sName & " не соответствует ни одному шаблону "
  End If
End Sub

[viter.alex]

2EducatedFool. А букву сделать прописной после апострофа или дефиса?
Ограничить это хорошо. Как я сразу не додумался?
Да еще и запретить вводить более двух пробелов. Хотя если будет какой-нибудь Бюль-Бюль Оглы или Хосе Игнасио, то он обидется.

[EducatedFool]

А букву сделать прописной после апострофа или дефиса?

Надо дописать маленькую функцию.
Например, такую:

Private Sub FIO_Change()
    ' срабатывает при изменении содержимого поля ввода

    txt = LTrim$(Me.FIO)    ' считывает в переменную текст из поля, сразу убирая пробелы слева
    txt = StrConv(txt, vbProperCase)    ' делаем первые символы слов заглавными
    txt = Replace(txt, "  ", " ")    ' заменяем двойные пробелы одинарными
    txt = СделатьБуквыПрописнымиПослеСимволов("`'-", txt)

    If txt <> Me.FIO Then Me.FIO = txt    ' если обработанный текст отличается от находящегося в поле ввода
    ' то записываем обработанный текст в поле (заменяя то, что там было)
End Sub


Function СделатьБуквыПрописнымиПослеСимволов(ByVal s As String, ByVal txt As String) As String
    For i = 1 To Len(s):        txt = Replace(txt, Mid$(s, i, 1), Space(3 + i)):    Next i
    txt = StrConv(txt, vbProperCase)
    For i = Len(s) To 1 Step -1:        txt = Replace(txt, Space(3 + i), Mid$(s, i, 1)):    Next i
    СделатьБуквыПрописнымиПослеСимволов = txt
End Function

Да еще и запретить вводить более двух пробелов

А разве код разрешает вводить 2 пробела подряд?

txt = Replace(txt, "  ", " ")    ' заменяем двойные пробелы одинарными

[viter.alex]

Сообщение от EducatedFool

…А разве код разрешает вводить 2 пробела подряд?

txt = Replace(txt, "  ", " ")    ' заменяем двойные пробелы одинарными

Я имел ввиду более 2-х пробелов в строке