如何通过VBA实现Word文档仅首页添加页眉？

问题场景 #

使用VBA从Excel生成Word文档时，希望仅在首页添加页眉，但现有代码导致页眉出现在第二页及之后的所有页面，尝试多种修改方式均未解决。

错误原因 #

原代码中，页眉内容被写入了Word的通用页眉（对应数值1），当开启DifferentFirstPageHeaderFooter后，通用页眉会自动应用到除首页外的所有页面。即使尝试清空其他节的页眉，也因为初始内容写在了通用页眉上，导致后续页面仍会显示该内容。

修正后的完整代码 #

Sub CreateWordFileFromExcel()
    Dim wordApp As Object
    Dim wordDoc As Object
    Dim filePath As String
    Dim desktopPath As String
    Dim headerRange As Object

    ' 创建Word应用并新建文档
    Set wordApp = CreateObject("Word.Application")
    wordApp.Visible = True
    Set wordDoc = wordApp.Documents.Add

    ' 设置保存路径
    desktopPath = Environ("USERPROFILE") & "\Desktop\"
    filePath = desktopPath & "TemplateMEMO.docx"

    ' 开启首页单独页眉页脚
    wordDoc.PageSetup.DifferentFirstPageHeaderFooter = True

    ' 写入首页专属页眉（对应Word的wdHeaderFooterFirstPage，数值为2）
    Set headerRange = wordDoc.Sections(1).Headers(2).Range
    headerRange.Text = "Company name" & vbCr & _
                       "Address" & vbCr & _
                       "City" & vbCr & _
                       "Country" & vbCr & _
                       "Tel: +7 (727) 777 77 77" & vbCr & _
                       "Fax: +7 (727) 888 88 88" & vbCr & _
                       "company website"
    headerRange.ParagraphFormat.Alignment = 2 ' 居中对齐
    headerRange.Font.Size = 9

    ' 复制并粘贴Excel内容
    ThisWorkbook.Sheets("1").UsedRange.Copy
    wordApp.Selection.Collapse Direction:=0 ' 定位到文档末尾
    ThisWorkbook.Sheets("2").UsedRange.Columns.AutoFit
    wordDoc.Range.PasteExcelTable LinkedToExcel:=False, WordFormatting:=False, RTF:=False

    ' 保存文档并释放对象
    wordDoc.SaveAs filePath
    Set headerRange = Nothing
    Set wordDoc = Nothing
    Set wordApp = Nothing
End Sub

关键修改说明 #

1. 优先开启首页不同页眉：在写入页眉内容前，先设置wordDoc.PageSetup.DifferentFirstPageHeaderFooter = True，确保Word激活首页专属页眉区域。
2. 写入首页专属页眉：将原代码中Headers(1)改为Headers(2)，对应Word的首页专属页眉区域，这样内容只会出现在首页。
3. 移除无效循环：无需循环清空其他节的页眉，因为通用页眉（Headers(1)）初始为空，开启首页不同页眉后，后续页面会自动使用空白的通用页眉。

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