編輯嵌入在工作簿中的Word文檔並另存為副本

Question

我已經制作了一個Word模板，並將其作為對象插入到Excel中。 我正在用代碼打開它，並將數據輸入到書簽和主要部分。 但是，在完成代碼處理之后，我的嵌入式模板將所有數據存儲在其中。 因此，它不再是模板，而是我使用代碼創建的文件。

嵌入式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. 不要使用Activate方法在這種情況下（注釋掉）。 如果對象已經被就地激活，則無法在Word.Application中打開文檔。

3. 使用帶有參數xlOpen的OLEFormat.Object.Verb方法在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