Word VBA: Макрос двойная фамилия.

[Irina18]

Привет всем. Пытаюсь переделать приведенный на форуме макрос, чтобы он мог работать с двойной фамилией, но не всё получилось. Результат работы макроса должен быть следующий:
- в поле сотрудник текст ввожу строчными буквами (иванов-смирнов иван иванович)
- после выхода из поля сотрудник в нем должно отобразиться (Иванов-Смирнов Иван Иванович), а в полях с ФИО, соответственно (Иванов-Смирнов И.И.).
Если фамилия в одно слово, то правильный результат в ФИО у меня получился, добавила в макрос

Спойлер

sText = StrConv(sText, vbProperCase)

[свернуть]

но не получается в поле сотрудник, после выхода из него, перевести первые буквы в заглавные.
Также не получается и с двойной фамилией.
Макрос

Спойлер

Sub Sotrudnik1()
    FIOname 1
End Sub
Sub Sotrudnik2()
    FIOname 2
End Sub
Private Sub FIOname(index As Long)

    Dim sText As String, sResult1 As String
    Dim sArray() As String
   
    sText = GetFormfield(ActiveDocument.Bookmarks("name_" & index).Range).Result
    sText = StrConv(sText, vbProperCase)
    sArray = Split(sText)
    sResult1 = sArray(0) & " "
    sResult1 = sResult1 & Left(sArray(1), 1) & ". "
    sResult1 = sResult1 & Left(sArray(2), 1) & "."
    GetFormfield(ActiveDocument.Bookmarks("fio1_" & index).Range).Result = sResult1
    GetFormfield(ActiveDocument.Bookmarks("fio2_" & index).Range).Result = sResult1
End Sub
Private Function GetFormfield(BmRange As Range) As FormField
    Dim FormField As FormField
    For Each FormField In BmRange.FormFields
        Set GetFormfield = FormField
        Exit For
    Next FormField
End Function

[свернуть]

Мой файл во вложении. Word у меня 2007. Всем спасибо.


[вложение удалено администратором]

[Администратор]

Макрос

Private Sub FIOname(index As Long)

    Dim FullText, FIO As String
    Dim sArray() As String
    Dim i As Long
   
    FullText = GetFormfield(ActiveDocument.Bookmarks("name_" & index).Range).result
    FullText = StrConv(FullText, vbProperCase)
   
    ' Делаем большими буквами фио, если в ней сложная фамилия или имя: Иванов-Петров.
    ' Разбивка фио по дефисам на части.
    FullText = Split(FullText, "-")
    ' Цикл по частям.
    For i = 0 To UBound(FullText)
        ' Делаем первые буквы большими. При этом у слов, которые перед дефисом,
            ' уже будет большая буква. Но всё равно делается, чтобы упростить код,
            ' не делая лишних действий.
        FullText(i) = StrConv(FullText(i), vbProperCase)
    Next i
    ' Соединение частей с добавлением дефисов.
    FullText = Join(FullText, "-")
   
    sArray = Split(FullText, " ")
    FIO = sArray(0) & " "
    FIO = FIO & Left(sArray(1), 1) & ". "
    FIO = FIO & Left(sArray(2), 1) & "."
    GetFormfield(ActiveDocument.Bookmarks("name_" & index).Range).result = FullText
    GetFormfield(ActiveDocument.Bookmarks("fio1_" & index).Range).result = FIO
    GetFormfield(ActiveDocument.Bookmarks("fio2_" & index).Range).result = FIO
   
End Sub

[свернуть]

[Irina18]

Спасибо выручили. Как всегда все отлично.

[Irina18]

Набралась смелости и прошу сделать тоже самое для элемента управления "форматируемый текст". Спасибо.

[вложение удалено администратором]

[Администратор]

Может быть вам будет удобнее элемент управления содержимым "обычный текст"? Тогда можно клавишей Tab переходить от элемента к элементу.

[Irina18]

Давайте попробуем этот элемент.

[Администратор]

Код для модуля ThisDocument.

Код:

Private Sub Document_ContentControlOnExit(ByVal ContentControl As ContentControl, Cancel As Boolean)
   
    Dim index As String, full, fio, control As ContentControl
    Dim i As Long
   
   
    '1. Если выход произошёл в ненужном контроле.
    If InStr(ContentControl.Tag, "sotr") = 0 Then
        Exit Sub
    End If
   
    '2. Запись порядкового номера.
    index = Split(ContentControl.Tag, "_")(1)
   
    '3. Если в контроле пусто.
    If ContentControl.ShowingPlaceholderText = True Then
        ClearContents index
        Exit Sub
    End If
   
    '4. Копирование текста из контрола в переменную.
    full = ContentControl.Range.Text
   
    '5. Первые буквы прописными.
    full = StrConv(full, vbProperCase)
   
    '6. Первый буквы прописными в сложных фамилиях и именах (то есть с дефисом).
    ' Разбивка фио на части по дефису.
    full = Split(full, "-")
    ' Цикл по частям.
    For i = 0 To UBound(full)
        full(i) = StrConv(full(i), vbProperCase)
    Next i
    ' Соединение частей обратно.
    full = Join(full, "-")
   
    '7. Инициалы для имени и отчетства.
    ' Разбивка фио по пробелам. Должно быть три части.
    fio = Split(full, " ")
    ' Инициалы имени.
    fio(1) = Left(fio(1), 1) & "."
    ' Инициалы отчетства.
    fio(2) = Left(fio(2), 1) & "."
    ' Соединение обратно.
    fio = Join(fio, " ")
   
    '8. Вставка данных в контролы.
    ContentControl.Range.Text = full
    For Each control In ActiveDocument.ContentControls
        ' Просмотр тега контрола.
        If InStr(control.Tag, "insotr") = 1 Then
            ' Просмотр, что в теге после подчёркивания.
            If Split(control.Tag, "_")(1) = index Then
                control.Range.Text = fio
            End If
        End If
    Next control
   
End Sub

Private Sub ClearContents(index As String)
   
    ' Очистка контролов "фио", если в поле "Сотрудник" что-то не то.
   
    Dim control As ContentControl

    For Each control In ActiveDocument.ContentControls
        ' Просмотр тега контрола.
        If InStr(control.Tag, "insotr") = 1 Then
            ' Просмотр, что в теге после подчёркивания.
            If Split(control.Tag, "_")(1) = index Then
                control.Range.Text = ""
            End If
        End If
    Next control

End Sub

[свернуть]

А почему вы решили попробовать элементы управления содержимым? Есть какие-то недостатки у "полей формы"?

[Irina18]

Проблем с полями формы нет, просто на некоторых форумах говорят что они устарели и лучше пользоваться полями форматируемый текст. Но с полями форматируемый текст, которые привязаны к макросам у меня в Word 2007 были проблемы. При активации поля макрос как бы зацикливался и если я переключалась на другую любую вкладку на ленте, зацикливание останавливалось и все работало нормально. Эти же файлы в word 2016 работали нормально.

[Irina18]

Огромное Вам спасибо. Желаю Вам удачи.

[Irina18]

Извините за назойливость, но ваше предложение использовать элемент управления "обычный текст" подходит лучше, чем предыдущий "форматируемый текст". Согласно моей женской логики, заменила в коде ContentControl на PlainTextContentControl, но что-то не работает. Если есть свободное время посмотрите, где там ошибка.

Спойлер

Private Sub Document_PlainTextContentControlOnExit(ByVal PlainTextContentControl As PlainTextContentControl, Cancel As Boolean)
' Для преобразования Фамилии, имя и отчество в ФИО
  Dim index As String, full, fio, control As PlainTextContentControl
    Dim i As Long
   
    '1. Если выход произошёл в ненужном контроле.
    If InStr(PlainTextContentControl.Tag, "name") = 0 Then
        Exit Sub
    End If
   
    '2. Запись порядкового номера.
    index = Split(PlainTextContentControl.Tag, "_")(1)
   
    '3. Если в контроле пусто.
    If PlainTextContentControl.ShowingPlaceholderText = True Then
        ClearContents index
        Exit Sub
    End If
   
    '4. Копирование текста из контрола в переменную.
    full = PlainTextContentControl.Range.Text
   
    '5. Первые буквы прописными.
    full = StrConv(full, vbProperCase)
   
    '6. Первый буквы прописными в сложных фамилиях и именах (то есть с дефисом).
    ' Разбивка фио на части по дефису.
    full = Split(full, "-")
    ' Цикл по частям.
    For i = 0 To UBound(full)
        full(i) = StrConv(full(i), vbProperCase)
    Next i
    ' Соединение частей обратно.
    full = Join(full, "-")
   
    '7. Инициалы для имени и отчетства.
    ' Разбивка фио по пробелам. Должно быть три части.
    fio = Split(full, " ")
    ' Инициалы имени.
    fio(1) = Left(fio(1), 1) & "."
    ' Инициалы отчетства.
    fio(2) = Left(fio(2), 1) & "."
    ' Соединение обратно.
    fio = Join(fio, " ")
   
    '8. Вставка данных в контролы.
    PlainTextContentControl.Range.Text = full
    For Each control In ActiveDocument.ContentControls
        ' Просмотр тега контрола.
        If InStr(control.Tag, "inname") = 1 Then
            ' Просмотр, что в теге после подчёркивания.
            If Split(control.Tag, "_")(1) = index Then
                control.Range.Text = fio
            End If
        End If
    Next control
   
End Sub

Private Sub ClearContents(index As String)
   
    ' Очистка контролов "фио", если в поле "name" что-то не то.
   
    Dim control As PlainTextContentControl

    For Each control In ActiveDocument.ContentControls
        ' Просмотр тега контрола.
        If InStr(control.Tag, "inname") = 1 Then
            ' Просмотр, что в теге после подчёркивания.
            If Split(control.Tag, "_")(1) = index Then
                control.Range.Text = ""
            End If
        End If
    Next control

End Sub

[свернуть]

и мой файл.

[вложение удалено администратором]

[Администратор]

Список возможных событий для объекта "Document" можно посмотреть так.
Перейдите в модуль "ThisDocument" - справа вверху в первом выпадающем списке выберите Document.
В модуль будет вставлено событие Document_New, но оно вам не нужно.
Теперь справа вверху раскройте список и увидите все события объекта Document. Там нет события Document_PlainTextContentControlOnExit.
Вам нужно оставить то событие, которое было, оно одно и для форматированных и для обычных контролов.

[Irina18]

Всё исправила и заработало. Спасибо.