Копирование всего содержимого в OLEObject, включая нижний колонтитул с форматом, в новый Word.Document / Word.Application

Question

В последнее время мне удается сделать автоматизацию в VBA, в которой файл внешнего слова в той же папке, что и файл Excel, открыт, и добавить новый контент из Excel, а затем сохранить как файл слова другое имя. Ниже код:

Dim wordapp As Word.Application
Dim wordfile As Word.Document
Set wordapp = New Word.Application
Set wordfile = wordapp.Documents.Open(Application.ActiveWorkbook.Path & "<word file name>")

wordapp.Visible = False
<code to manipulate the word.document to insert value and graph from excel>
wordfile.SaveAs Filename:=Application.ActiveWorkbook.Path & "<new word file name>"
wordapp.Quit
Set wordapp = Nothing
Set wordfile = Nothing

Исходный файл внешних слов ведет себя как шаблон с верхним и нижним колонтитулами и некоторым абзацем.

Поскольку характер моего проекта, мне нужно встроить файл внешних слов в Excel, превратив файл внешних слов в OLEObject в файле Excel. Даже несмотря на то, что мне удается открыть OLEObject и манипулировать словом.document для вставки значения и графика из Excel и сохранения в виде внешнего файла слов, закрытый OLEObject также сохранит значение вставки и график, что сделает его неподходящим для использования в качестве шаблона.

Я придумала этот код. В основном, чтобы открыть OLEObject и скопировать содержимое, затем создайте новый файл слова и вставьте в него содержимое, чтобы OLEObject не сохранил никаких изменений:

Dim objSampleReport As OLEObject
Dim wordApp As Word.Application
Dim wordFileEmbed As Word.Document
Dim wordFileNew As Word.Document

Set objSampleReport = pgReport.OLEObjects("objSampleReport")
objSampleReport.Verb xlVerbPrimary
Set wordFileEmbed = objSampleReport.Object
Set wordApp = New Word.Application
Set wordFileNew = wordApp.Documents.Add

wordFileEmbed.Content.Copy
wordFileNew.Content.PasteAndFormat

wordFileEmbed.Application.Quit False

<code to manipulate the word.document to insert value and graph from excel using wordApp.selection>

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

Итак, я пытаюсь записать поведение копировальной пасты, используя Word Macro, и это происходит:

Selection.WholeStory
Selection.Copy
Windows("Document1").Activate
Selection.PasteAndFormat (wdUseDestinationStylesRecovery)

С этим новым знанием дела я пытаюсь придумать что-то похожее, как описано выше. Это код:

Dim objSampleReport As OLEObject
Dim wordAppEmbed As Word.Application
Dim wordAppNew As Word.Application
Dim wordFileEmbed As Word.Document
Dim wordFileNew As Word.Document

Set objSampleReport = pgReport.OLEObjects("objSampleReport")
objSampleReport.Verb xlVerbPrimary
Set wordAppEmbed = objSampleReport.Object.Application
Set wordAppNew = New Word.Application
Set wordFileNew = wordAppNew.Documents.Add

wordAppEmbed.Activate
wordAppEmbed.Selection.WholeStory
wordAppEmbed.Selection.Copy
wordAppNew.Activate
wordAppNew.Selection.PasteAndFormat

wordAppEmbed.Quit False

<code to manipulate the word.document to insert value and graph from excel using wordApp.selection>

Но это все равно приводит к тому, что нижний колонтитул не был скопирован и формат по-прежнему неправильный. Я пытаюсь поиграться с параметром типа .PasteAndFormat, но результат остается тем же.

Может кто-нибудь помочь мне с этой проблемой? Другой вариант - использовать шаблон в качестве внешнего файла слов и использовать первый код, но для этого требуется, чтобы я отправлял файл Excel и файл слов одновременно, и может произойти ошибка человека, если пользователь только копирует файл Excel.

Answer 1

Может попробовать что-нибудь в соответствии со следующим кодом

Sub NewTest()
Dim objSampleReport As OLEObject
Dim wordAppEmbed As Word.Application
'Dim wordAppNew As Word.Application
Dim wordFileEmbed As Word.Document
Dim wordFileNew As Word.Document
Dim pgReport As Worksheet
Set pgReport = ThisWorkbook.Sheets("Sheet1")  'Used for test purpose. May Use your choice

Set objSampleReport = pgReport.OLEObjects("Object 2") 'Used for test purpose. Use use choice

objSampleReport.Verb xlOpen
Set wordAppEmbed = objSampleReport.Object.Application
Set wordFileEmbed = wordAppEmbed.ActiveDocument
Set wordFileNew = wordAppEmbed.Documents.Add
wordFileEmbed.Content.Copy
wordFileNew.Range.Paste
wordFileEmbed.Close
' Now may Work with wordFileNew for further processing New file
End Sub

Редактировать Как подсказывает экспертное заключение @Cindy Meister и ценный комментарий , я также чувствую , сначала сохраняя вложенный документ в виде нового файла, затем открывая этот документ, гораздо более разумный вариант, Мой последний код - просто попытка заставить ваш код работать и протестирован только на простом шаблоне. (Может не получиться со сложными документами). Поэтому я публикую модифицированный код в соответствии с комментарием @Cindy Meister

Sub NewTest2()
Dim objSampleReport As OLEObject
Dim wordAppEmbed As Word.Application
Dim wordFileEmbed As Word.Document
Dim wordFileNew As Word.Document
Dim pgReport As Worksheet, Fname As String
Set pgReport = ThisWorkbook.Sheets("Sheet1") 'Modify to your choice
Fname = "C:\users\user\Desktop\Test2.docx"   'Modify to your choice

Set objSampleReport = pgReport.OLEObjects("Object 2") 'Used for test purpose. May modify to your choice
objSampleReport.Verb xlOpen
Set wordAppEmbed = objSampleReport.Object.Application
Set wordFileEmbed = wordAppEmbed.ActiveDocument
wordFileEmbed.SaveAs Fname
wordFileEmbed.Close
Set wordFileNew = wordAppEmbed.Documents.Open(Fname)

' Now may Work with wordFileNew for further processing New file

End Sub

.