Редактировать документ Word, встроенный в рабочую книгу, и сохранить его как копию

Question

Я сделал шаблон Word и вставил его в Excel как объект.Я открываю его с помощью кода и вводу данных в закладки и основную часть.Однако после того, как код сделан, делая процессы, мой встроенный шаблон содержит все данные внутри.Так что это уже не шаблон, а файл, который я создал с помощью кода.

Шаблон Embedded Word следует открывать как копию, так как я не хочу вносить какие-либо изменения в исходный встроенный шаблон или обнулять его с помощьюкод все время (или это единственный способ сделать это?).Возможно ли с помощью кода открыть встроенный документ Word в качестве копии, внести в него изменения и сохранить его в виде документа Word?Я не могу найти ничего полезного в интернете.

Sub opentemplateWord()
Dim sh As Shape
Dim objWord As Object ''Word.Document
Dim objOLE As OLEObject
Dim wSystem As Worksheet
Dim cell As Range


    Set wSystem = Worksheets("Templates")
''The shape holding the object from 'Create from file'
''Object 2 is the name of the shape
Set sh = wSystem.Shapes("Object 2")
''Activate the contents of the object
sh.OLEFormat.Activate
''The OLE Object contained
Set objOLE = sh.OLEFormat.Object
''This is the bit that took time
Set objWord = objOLE.Object


'>------- This Part Inputs Bookmarks

objWord.Bookmarks.Item("ProjectName1").Range.Text = ThisWorkbook.Sheets("MAIN").Range("D15").Value
objWord.Bookmarks.Item("ProjectName2").Range.Text = ThisWorkbook.Sheets("MAIN").Range("D16").Value


'>------- This Part Inputs Text


  'ActiveWindow.ActivePane.View.SeekView = wdSeekMainDocument '<--- This is for closing footer and header?


    With objWord '<--| reference 'Selection' object


For Each cell In ThisWorkbook.Worksheets("Offer Letter").Range("C1", ThisWorkbook.Worksheets("Offer Letter").Range("C" & Rows.Count).End(xlUp))
     Select Case LCase(cell.Value)
    Case "title"
                .TypeParagraph
                .Style = objWord.ActiveDocument.Styles("Heading 1")
                .TypeText Text:=cell.Offset(0, -1).Text
    Case "main"
                .TypeParagraph
                .Style = objWord.ActiveDocument.Styles("Heading 2")
                .TypeText Text:=cell.Offset(0, -1).Text


    Case "sub"
                .TypeParagraph
                .Style = objWord.ActiveDocument.Styles("Heading 3")
                .TypeText Text:=cell.Offset(0, -1).Text


    Case "sub-sub"
                .TypeParagraph
                .Style = objWord.ActiveDocument.Styles("Heading 4")
                .TypeText Text:=cell.Offset(0, -1).Text



    End Select
   Next cell
    End With


objWord.Application.Visible = False

''Easy enough
    objWord.SaveAs2 ActiveWorkbook.Path & "\" & Sheets("Other Data").Range("AN2").Value & ", " & Sheets("Other Data").Range("AN7").Value & "_" & Sheets("Other Data").Range("AN8").Value & "_" & Sheets("Other Data").Range("AX2").Value & ".docx"


End Sub

Answer 1

Это интересная задача, которую я не рассматривал в течение нескольких лет ... Хитрость заключается в том, чтобы открыть документ в интерфейсе приложения Word , а не на месте в Excel.

Я адаптировал код в вопросе.Чтобы было легче следить (короче), я удалил редактирование в документе Word, за исключением записи в несколько закладок.Это, конечно, можно вернуть обратно.

1. Я очень рекомендую использовать VBA для присвоения имени для Shape.Приложения Office не стесняются изменять присваиваемое им общее имя, поэтому использование «Объекта 2» может иногда приводить к проблемам.

2. Do NOT используйте метод Activate в этом сценарии (закомментировано).Если объект уже активирован на месте, документ нельзя открыть в приложении Word.Application.

3. Используйте метод OLEFormat.Object.Verb с параметром xlOpen, чтобы открыть документ в Word..

4. После открытия объект OLE может быть установлен на объект документа Word.

5. Из ваших комментариев: 'ActiveWindow.ActivePane.View.SeekView = wdSeekMainDocument '<--- This is for closing footer and header? Нет.Лучше работать с соответствующими Range объектами.Для этого есть множество примеров.Задайте новый вопрос, если у вас возникнут проблемы с их использованием.

6. Документ Word, открытый в приложении Word, можно сохранить в виде файла (документ, открытый на месте, не может).Вопрос о том, чтобы не сохранять изменения, есть ... Есть два основных подхода:

   • Сохранить как перед редактированием, открыть этот документ, редактировать и сохранить.Затем оригинал должен быть нетронутым
   • Выполнить редактирование объекта, затем сохранить отменить изменения.Этот подход показан в примере кода

7. Объектная модель Word способна сгруппировать любое количество действий в одну «запись отмены».

   Set objUndo = objWord.Application.UndoRecord
   objUndo.StartCustomRecord "Edit In Word"
   

После завершения редактирования вернуться к «пустому» (неизменному) документу:

    objUndo.EndCustomRecord
    Set objUndo = Nothing
    objWord.Undo

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

Sub opentemplateWord()
    Dim sh As Shape
    Dim objWord As Object, objNewDoc As Object ''Word.Document
    Dim objOLE As OLEObject
    Dim wSystem As Worksheet
    Dim cell As Range       

    Set wSystem = Worksheets("Templates")
    ''The shape holding the object from 'Create from file'
    ''Object 2 is the name of the shape
    Set sh = wSystem.Shapes("WordFile")
    ''The OLE Object contained
    Set objOLE = sh.OLEFormat.Object
    'Instead of activating in-place, open in Word
    objOLE.Verb xlOpen
    Set objWord = objOLE.Object 'The Word document    

    Dim objUndo As Object 'Word.UndoRecord        
   'Be able to undo all editing performed by the macro in one step
    Set objUndo = objWord.Application.UndoRecord
    objUndo.StartCustomRecord "Edit In Word"

    With objWord
        .Bookmarks.Item("ProjectName1").Range.Text = ThisWorkbook.Sheets("MAIN").Range("D15").Value
        .Bookmarks.Item("ProjectName2").Range.Text = ThisWorkbook.Sheets("MAIN").Range("D16").Value

        objWord.SaveAs2 ActiveWorkbook.Path & "\" & Sheets("Other Data").Range("AN2").Value & _
           ", " & Sheets("Other Data").Range("AN7").Value & "_" & _
           Sheets("Other Data").Range("AN8").Value & "_" & _
           Sheets("Other Data").Range("AX2").Value & ".docx"

        objUndo.EndCustomRecord
        Set objUndo = Nothing
        objWord.Undo
        .Application.Quit False

    End With
    Set objWord = Nothing
End Sub