Как создать универсальный шаблон письма в Word'е?

Question

[Иван Выров]

Добрый день!
Есть письмо оформленное следующим образом:

Необходимо сделать шаблон который бы имел возможность:

1. Заполнение всех желтых полей
   
2. Вставки блока №1(красный прямоугольник) до 3 раз подряд
   
3. Исключение блока №2 (синий прямоугольник) т.е. убрать из шаблона письма в случаи отсутствия приложений к письму
   

При всем этом заблокировать доступ к редактированию основного (черного) текста
Вопрос: Как все это можно реализовать? Думаю что VBA вполне с этим справиться, только вот думаю как скрипт запускать автоматом, т.е. что бы пользователь не нажимал дополнительных кнопочек типа "проверить документ" для запуска скрипта.

Просьба скидывать ссылки на информацию по данной теме, буду признателен.

Answer 1

[h8nor]

1. Можно промаркировать жёлтый текст и сделать замену прямо в Word (в примере 1 замена во всём тексте), или использовать закладки (Вставка (меню) -> Ссылки (группа) -> Закладки), или использовать инструмент Слияние и брать данные из файла Excel (без VBA). При слиянии связи могут глючить + конечный документ необходимо Объединить (как текущую запись), чтобы при работе с документом поля не обновлялись (Слияние использовать не советую). К тому же поля не поддерживают неразрывные символы Word'а Chr(160) и Chr(30).
   
   Примечание к документам слияния

   
   В таблице Excel есть поле Дата_1 (тип Дата) и поле Дата_2 (тип Дата). Если значение Дата_1 равно 43003 и значение Дата_2 равно 44764, то в формула ниже посчитается с ошибкой (будет значение ИСТИНА):
   

   { IF { MERGEFIELD Дата_1 \@"DD.MM.YYYY' г.'"  \* MERGEFORMAT } = { MERGEFIELD Дата_2 \@"DD.MM.YYYY' г.'"  \* MERGEFORMAT } "ИСТИНА" "ЛОЖЬ" }

   
   

   Option Explicit
   '123456789012345678901234567890123456h8nor@ya567890123456789012345678toster56789
   
   Sub Replacement_tags()
     Dim Content_Find As Find ' Объект Find
     
     Set Content_Find = ActiveDocument.Content.Find
     With Content_Find ' Найти маркер
       .ClearFormatting: .Replacement.ClearFormatting ' Очистить формат
       .MatchWildcards = False ' ВАЖНО! Отключить Подстановочные знаки
       
       .Text = "[Шапка]": .Replacement.Text = "Начальнику управления..."
       .Execute Forward:=True, Replace:=wdReplaceAll ' Заменить все маркеры [Шапка]
       
       ' Хитрость: перемещение курсора в конец заменённого текста
       .Execute FindText:=.Replacement.Text, _
         Forward:=True, Wrap:=wdFindStop, Replace:=wdReplaceNone
       .Parent.Select ' Выделяем текст для управления курсором
       'Selection.Collapse Direction:=wdCollapseEnd ' Курсор в конец найденного
     End With
   End Sub

2. Можно сразу заменить на дублированный текст:

   .Replacement.Text = "Начальнику управления..." & String(3, Chr(13)) & "Начальнику управления..."

   или вводить количество дублей в переменную Text перед заменой:

   ' Chr(13) - код символа возврата каретки. В других языках более привычная запись "\r"
   
     CapText = "Начальнику управления..."
     CapСount = InputBox("Введите количество 'Шапок'", , 1)
     If Not CInt(Val(CapСount)) = CapСount Then _
       MsgBox "Введите целое число", vbCritical: Exit Sub _
     Else Text = CapText
     
     While CapСount > 1
       Text = Text & String(3, Chr(13)) & CapText
       CapСount = CapСount - 1
     Wend

3. Таблицу можно также подтягивать через Слияние (точнее там создаётся объект OLE, которой глючит больше чем обычные поля - в основном это удержание файла Excel, откуда берутся данные). Удобнее программно создавать таблицу:

   ' Используем хитрость из п.1, если планируем создать таблицу в месте маркера
     
     Set tblNew = ActiveDocument.Tables.Add(Selection.Range, 3, 2)
     With tblNew
       .Columns(1).PreferredWidth = CentimetersToPoints(4) ' Колонка 1, Ширина 4 см
       .Borders(wdBorderTop).LineStyle = wdLineStyleNone ' Границы таблицы, например
       .Borders(wdBorderHorizontal).LineStyle = wdLineStyleSingle
       .Borders(wdBorderVertical).LineStyle = wdLineStyleDot
       For i = 1 To 2
         .Cell(1, i).Range.Text = "Строка 1; #" & i
       Next i
       .Cell(1, 1).Range.InsertAfter Chr(13) & "Строка 2" ' Добавить текст
       .Cell(tblNew.Rows.count, tblNew.Columns.count).Range.InsertAfter "Последняя ячейка"
     End With

4. Чтобы основной текст нельзя было отредактировать, проще всего создать шаблон Word с поддержкой макросов, основную процедуру (автозапуск) разместить в модуле ThisDocument:

   Private Sub Document_Open()
     Replacement_tags ' Процедура из п.1
   End Sub

   Данные для заполнения шаблона можно поместить в отдельный файл.
   

+
Как использовать отладчик:

1. Открыть MS Word, в тексте написать маркер [Шапка]
2. Открыть VBA в приложении (Alt+F11)
3. Выбирать в меню Insert -> Module
4. Вставить процедуру (из п.1)
5. Нажать F5 (запустится процедура, в которой установлен курсор)