Привет всем. Пытаюсь переделать приведенный на форуме макрос, чтобы он мог работать с двойной фамилией, но не всё получилось. Результат работы макроса должен быть следующий:
- в поле сотрудник текст ввожу строчными буквами (иванов-смирнов иван иванович)
- после выхода из поля сотрудник в нем должно отобразиться (Иванов-Смирнов Иван Иванович), а в полях с ФИО, соответственно (Иванов-Смирнов И.И.).
Если фамилия в одно слово, то правильный результат в ФИО у меня получился, добавила в макрос
Спойлер
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
Спасибо выручили. Как всегда все отлично.
Набралась смелости и прошу сделать тоже самое для элемента управления "форматируемый текст". Спасибо.
[вложение удалено администратором]
Может быть вам будет удобнее элемент управления содержимым "обычный текст"? Тогда можно клавишей Tab переходить от элемента к элементу.
Давайте попробуем этот элемент.
Код для модуля 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
А почему вы решили попробовать элементы управления содержимым? Есть какие-то недостатки у "полей формы"?
Проблем с полями формы нет, просто на некоторых форумах говорят что они устарели и лучше пользоваться полями форматируемый текст. Но с полями форматируемый текст, которые привязаны к макросам у меня в Word 2007 были проблемы. При активации поля макрос как бы зацикливался и если я переключалась на другую любую вкладку на ленте, зацикливание останавливалось и все работало нормально. Эти же файлы в word 2016 работали нормально.
Огромное Вам спасибо. Желаю Вам удачи.
Извините за назойливость, но ваше предложение использовать элемент управления "обычный текст" подходит лучше, чем предыдущий "форматируемый текст". Согласно моей женской логики, заменила в коде 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.
Вам нужно оставить то событие, которое было, оно одно и для форматированных и для обычных контролов.
Всё исправила и заработало. Спасибо.