Имеется шаблон документа .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
спасибо, все работает