我来帮你逐个解决遇到的这几个问题，这些都是嵌入OLE对象时常见的“坑”，咱们一步步拆解处理：

1. 避免修改原嵌入模板，实现独立另存 #

嵌入在Excel里的Word对象，直接操作oleObject.Object其实是在修改绑定的原模板实例，所以你的改动会同步回原模板。正确的做法是先把嵌入模板导出为临时文件，再打开这个临时文件编辑，这样原模板完全不受影响：

' 先把嵌入的Word模板导出为临时文件
Dim tempPath As String
tempPath = Environ("TEMP") & "\temp_bank_template.docx" ' 用docx格式更稳定
oleObject.Object.SaveAs2 tempPath

' 打开临时文件作为独立Word文档
Dim wApp As Object
Set wApp = CreateObject("Word.Application")
Set wDoc = wApp.Documents.Open(tempPath)
wApp.Visible = True ' 调试时保留，发布后可设为False后台运行

处理完成后，我们可以删除临时文件，同时关闭临时打开的Word文档，原嵌入模板全程保持 untouched。

2. 修复页眉/页脚面板无法关闭的问题 #

嵌入对象的ActiveWindow上下文和独立Word窗口不一样，直接用wDoc.Windows(1).View来切换视图更可靠，而且要确保在编辑完页眉后立即执行切换：

' 替换原来的关闭代码（如果未引用Word对象库，记得定义常量）
Const wdSeekMainDocument = 0
wDoc.Windows(1).View.SeekView = wdSeekMainDocument

如果你的Excel没有引用Word对象库，建议把所有Word内置常量用数值替代（比如wdHeaderFooterPrimary = 1），避免编译错误。

3. 解决额外页面的问题 #

出现额外页面通常是因为页眉内容导致页面高度超出了文档设置的边距，你可以在插入页眉内容后，调整页眉的段落格式来限制高度：

For j = 3 To 5
    With wDoc.Sections(j).Headers(1).Range ' 用数值1替代wdHeaderFooterPrimary
        .InsertAfter vbCrLf & UCase(ThisWorkbook.Sheets("Input").Cells(i, 6).Value)
        .InsertAfter vbTab
        .InsertAfter vbCrLf & vbCrLf & UCase(ThisWorkbook.Sheets("Input").Cells(i, 7).Value)
        .InsertAfter vbTab
        .InsertAfter vbCrLf & vbCrLf & "At close of business on 31 December " & DatePart("yyyy", ThisWorkbook.Sheets("Input").Cells(i, 4).Value)
        
        ' 调整页眉段落格式，防止撑出额外页面
        .ParagraphFormat.LineSpacing = 12 ' 设置固定行距
        .ParagraphFormat.SpaceAfter = 0
        .ParagraphFormat.SpaceBefore = 0
    End With
Next j

另外，在保存前可以检查并删除可能的空白页：

' 删除最后可能的空白页
Const wdWithInTable = 12
If wDoc.Bookmarks.Exists("\EndOfDoc") Then
    With wDoc.Bookmarks("\EndOfDoc").Range
        If .Information(wdWithInTable) = False And .Characters.Last.Previous = Chr(12) Then
            .Characters.Last.Previous.Delete
        End If
    End With
End If

完整修改后的代码 #

把这些改动整合起来，最终代码如下：

Private Sub M114_Click()
    Dim oleObject As OLEObject
    Dim wApp As Object
    Dim wDoc As Object
    Dim tempPath As String
    Dim file_name As String
    Dim i As Integer, j As Integer
    
    ' 定义Word常量（未引用Word对象库时使用）
    Const wdHeaderFooterPrimary = 1
    Const wdSeekMainDocument = 0
    Const wdDoNotSaveChanges = 0
    Const wdWithInTable = 12
    
    Set oleObject = ActiveWorkbook.Sheets("Properties").OLEObjects(1)
    
    ' 导出嵌入模板到临时文件
    tempPath = Environ("TEMP") & "\temp_bank_template.docx"
    oleObject.Object.SaveAs2 tempPath
    
    ' 打开临时文件作为独立文档
    Set wApp = CreateObject("Word.Application")
    Set wDoc = wApp.Documents.Open(tempPath)
    wApp.Visible = True ' 调试时保留，发布后可设为False
    
    i = 3 ' 测试用，后续可恢复循环逻辑
    
    ' 填充内容控件
    wDoc.ContentControls(1).Range.Text = ThisWorkbook.Sheets("Input").Cells(i, 2).Value
    wDoc.ContentControls(21).Range.Text = ThisWorkbook.Sheets("Input").Cells(i, 2).Value
    wDoc.ContentControls(2).Range.Text = ThisWorkbook.Sheets("Input").Cells(i, 13).Value
    wDoc.ContentControls(14).Range.Text = ThisWorkbook.Sheets("Input").Cells(i, 13).Value
    
    ' 更新第3-5页页眉
    For j = 3 To 5
        With wDoc.Sections(j).Headers(wdHeaderFooterPrimary).Range
            .InsertAfter vbCrLf & UCase(ThisWorkbook.Sheets("Input").Cells(i, 6).Value)
            .InsertAfter vbTab
            .InsertAfter vbCrLf & vbCrLf & UCase(ThisWorkbook.Sheets("Input").Cells(i, 7).Value)
            .InsertAfter vbTab
            .InsertAfter vbCrLf & vbCrLf & "At close of business on 31 December " & DatePart("yyyy", ThisWorkbook.Sheets("Input").Cells(i, 4).Value)
            
            ' 调整页眉段落格式
            .ParagraphFormat.LineSpacing = 12
            .ParagraphFormat.SpaceAfter = 0
            .ParagraphFormat.SpaceBefore = 0
        End With
    Next j
    
    ' 关闭页眉/页脚面板
    wDoc.Windows(1).View.SeekView = wdSeekMainDocument
    
    ' 删除空白页
    If wDoc.Bookmarks.Exists("\EndOfDoc") Then
        With wDoc.Bookmarks("\EndOfDoc").Range
            If .Information(wdWithInTable) = False And .Characters.Last.Previous = Chr(12) Then
                .Characters.Last.Previous.Delete
            End If
        End With
    End If
    
    ' 另存为独立文件
    file_name = Application.WorksheetFunction.Trim("BankConf-" & ThisWorkbook.Sheets("Input").Cells(i, 6).Value & "-" & ThisWorkbook.Sheets("Input").Cells(i, 7).Value & ".docx")
    wDoc.SaveAs2 ThisWorkbook.Path & "/" & file_name
    
    ' 清理资源
    wDoc.Close SaveChanges:=wdDoNotSaveChanges
    Kill tempPath ' 删除临时文件
    wApp.Quit
    
    ' 释放对象
    Set wDoc = Nothing
    Set wApp = Nothing
    Set oleObject = Nothing
End Sub

额外注意事项 #

• 建议保存为.docx格式，比.doc更稳定、兼容性更好
• 如果你的Excel项目引用了Word对象库（工具→引用→Microsoft Word xx.x Object Library），可以不用手动定义常量，直接使用Word内置常量
• 调试时保持wApp.Visible = True方便查看操作过程，正式使用时可设为False后台运行

内容的提问来源于stack exchange，提问作者user8355243