Word VBA Макросы: Замена части данных в шаблоне .dotm из документа .doc и сохраненте в .dotm с именем файла .doc

[Евгений Второй]

Имеется шаблон документа .dotm, нужно взять из другого документа .doc содержимое двух полей и, желательно, одной ячейки таблицы, заменить ими аналогичные данные шаблона и сохранить шаблон в .dotm с именем вышеописанного документа doc.

Сценарий: есть шаблон "Образец.dotm" и документ Имя.doc. Имя - величина переменная. В шаблоне "Образец.dotm" 3 значения заменяются данными из аналогичных полей документа "Имя. doc" и полученный документ сохраняется в виде "Имя.dotm".

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

Действия юзера какие? Юзер щёлкает кнопку и что макросу делать? Где искать шаблон, где искать документ?

[Евгений Второй]

Юзер (я) тупой. Не знает, как это реализовать.

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

Где находится шаблон? Где находится документ?
Макросу ведь надо указать, где шаблон, где документ.

[Евгений Второй]

а, Вы конкретно имеете в виду путь к ним.
Пусть D:\Образец.dotm
файлы .doc в D:\Шаблоны\ с вложенными папками (не обязательно вложенные, можно и в одну все скинуть, потом рассортировать).
могу прикрепить образцы файлов.
нужно много файлов редактировать.

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

Можно использовать и не конкретный путь, если у вас есть желание по-другому указать макросу шаблон и документ.

[Евгений Второй]

Пусть будет конкретный. Так, навереное проще. Главное, чтобы операция выполнялась пакетно или просто кликаньем на файл хотя бы.

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

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

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

И что нужно скопировать из документа и куда в шаблон?

[Евгений Второй]

Заменить "Данные шаблона" и "Заключение шаблона на "Результирующие данные документа" и "Результирующее заключение документа" соответственно.

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

В пунктах 1 и 3 укажите пути и имена файлов.

Макрос

Sub макрос()

    Dim shablon As Document, doc As Document
    Dim text As String
   
   
    ' Отключение монитора (может это ускорит макрос и чтобы не мерцало).
    Application.ScreenUpdating = False
   
    '1. Открытие шаблона и документа и присваиваем им имена,
        ' затем по этим именам будем обращаться к этим файлам.
    Set shablon = Documents.Open(FileName:="C:\Users\User\Desktop\Новая папка\Образец.dotm")
    Set doc = Documents.Open(FileName:="C:\Users\User\Desktop\Новая папка\Имя.doc", ReadOnly:=True)
   
    '2. Копирование данных из документа в шаблон.
        ' Копирование сначала в переменную, чтобы удалить с конца два спецсимвола.
        ' В конце каждой ячейки есть два спецсимвола. Один видно в режиме непечатаемых
        ' символов, он в виде кружка, второй вообще никогда не видно.
    text = doc.Tables(2).Cell(1, 1).Range.text
    text = Left(text, Len(text) - 1)
    shablon.Tables(2).Cell(1, 1).Range.text = text
   
    text = doc.Tables(3).Cell(1, 1).Range.text
    text = Left(text, Len(text) - 1)
    shablon.Tables(3).Cell(1, 1).Range.text = text
   
    '3. Сохранение и закрытие шаблона.
    shablon.SaveAs2 _
        FileName:="C:\Users\User\Desktop\Новая папка\" & Left(doc.Name, InStrRev(doc.Name, ".") - 1) & ".docm", _
        FileFormat:=wdFormatXMLTemplateMacroEnabled
    shablon.Close SaveChanges:=False
   
    '4. Закрытие документа.
    doc.Close SaveChanges:=False
   
    '5. Сообщение.
    Application.ScreenUpdating = True
    MsgBox "Готово.", vbInformation
   
End Sub

[свернуть]

[Евгений Второй]

спасибо, все работает