Word书签替换数据异常：地址信息无法正常显示问题排查

问题描述 #

我此前在Stack Overflow提出过类似问题，经建议更新代码后仍遇到异常：尝试用Excel宏将数据自动填充至Word模板的书签位置，期望将“..date..”替换为当前日期、“..ID..”替换为Excel中的ID，地址行书签替换为对应地址信息。但运行宏后，仅日期和ID正常显示，地址行书签被移除且内容未显示。

Word模板结构 #

..date..

..ID..

..Address Line 1..

..Address Line 2..

..Address Line 3..

Dear Customer,

宏代码 #

' Filepath to the data and template
Const FilesPath As String = "filepath"
Const TemplateFile As String = "temp.docx"

Sub CreateWordDocuments()
    Dim prenom As String
    Dim nom As String
    Dim firstname As String
    Dim lastname As String
    Dim add1 As String
    Dim add2 As String
    Dim add3 As String
    Dim id As String
    Dim wd As Word.Application
    Dim doc As Word.Document
    Dim tday
    Dim NomRange As Range, NomCell As Range, ws As Worksheet
   
    Set ws = ActiveSheet
    Set NomRange = ws.Range("A2", ws.Cells(Rows.Count, 1).End(xlUp))
    Set wd = New Word.Application
    wd.Visible = True
    
    For Each NomCell In NomRange.Cells
        
        Set doc = wd.Documents.Open(FilesPath & TemplateFile)
        With NomCell.EntireRow
        firstname = .Columns("C").Value
        lastname = .Columns("B").Value
        add1 = .Columns("X").Value
        add2 = .Columns("Y").Value
        add3 = .Columns("Z").Value
        id = .Columns("A").Value
        tday = Date
        If .Columns("J").Value = "Keep" Then
           doc.Bookmarks("date").Range.Text = tday
           doc.Bookmarks("id").Range.Text = id
           doc.Bookmarks("name").Range.Text = firstname & lastname
           doc.Bookmarks("add1").Range.Text = add1
           doc.Bookmarks("add2").Range.Text = add2
           doc.Bookmarks("add3").Range.Text = add3
           
           doc.SaveAs2 FilesPath & firstname & ".pdf", wdExportFormatPDF
           doc.Close False
        End If
        End With
    Next NomCell
    wd.Quit
End Sub

原因分析 #

1. 书签名称不匹配：宏代码中使用的地址书签名为add1/add2/add3，但模板里的占位符文本是“..Address Line 1..”等，若模板中实际设置的书签名称与宏内的名称不一致，代码会找不到对应书签，无法填充内容，甚至误删占位符。
2. 书签范围错误：若模板中地址占位符的书签未完全选中整个占位符文本（比如只选了部分字符），替换文本时会出现异常，导致内容不显示且书签丢失。
3. 空值与书签丢失问题：当Excel中地址列为空值时，直接赋值会清空书签范围内容；且Word默认替换书签文本后会删除原书签，空值情况下就会呈现“内容未显示”的状态，而日期/ID有值所以能正常显示。

解决步骤 #

1. 核对书签名称 #

打开Word模板，按下Ctrl+Shift+F5打开书签管理器，确认地址对应的书签名称确实是add1/add2/add3。若不一致，要么修改宏内的书签名称，要么调整模板里的书签名保持匹配。

2. 修正书签范围 #

在模板中，选中完整的地址占位符文本（比如“..Address Line 1..”），再重新设置书签，确保书签范围完全包含占位符内容。

3. 优化代码：处理空值并保留书签 #

替换书签文本时，默认会删除原书签，且空值会导致内容空白。可以添加辅助函数，替换后重新创建书签，并处理空值：

修改后的完整宏代码：

' Filepath to the data and template
Const FilesPath As String = "filepath"
Const TemplateFile As String = "temp.docx"

Sub CreateWordDocuments()
    Dim firstname As String
    Dim lastname As String
    Dim add1 As String
    Dim add2 As String
    Dim add3 As String
    Dim id As String
    Dim wd As Word.Application
    Dim doc As Word.Document
    Dim tday
    Dim NomRange As Range, NomCell As Range, ws As Worksheet
   
    Set ws = ActiveSheet
    Set NomRange = ws.Range("A2", ws.Cells(Rows.Count, 1).End(xlUp))
    Set wd = New Word.Application
    wd.Visible = True
    
    For Each NomCell In NomRange.Cells
        Set doc = wd.Documents.Open(FilesPath & TemplateFile)
        With NomCell.EntireRow
            firstname = .Columns("C").Value
            lastname = .Columns("B").Value
            add1 = .Columns("X").Value
            add2 = .Columns("Y").Value
            add3 = .Columns("Z").Value
            id = .Columns("A").Value
            tday = Date
            
            If .Columns("J").Value = "Keep" Then
                ' 使用辅助函数替换并保留书签
                ReplaceAndKeepBookmark doc, "date", tday
                ReplaceAndKeepBookmark doc, "id", id
                ReplaceAndKeepBookmark doc, "name", firstname & lastname
                ReplaceAndKeepBookmark doc, "add1", IIf(add1 = "", "", add1)
                ReplaceAndKeepBookmark doc, "add2", IIf(add2 = "", "", add2)
                ReplaceAndKeepBookmark doc, "add3", IIf(add3 = "", "", add3)
                
                doc.SaveAs2 FilesPath & firstname & ".pdf", wdExportFormatPDF
                doc.Close False
            End If
        End With
    Next NomCell
    wd.Quit
End Sub

' 辅助函数：替换书签文本并保留书签
Sub ReplaceAndKeepBookmark(doc As Word.Document, bookmarkName As String, newText As String)
    Dim rng As Word.Range
    
    If doc.Bookmarks.Exists(bookmarkName) Then
        Set rng = doc.Bookmarks(bookmarkName).Range
        rng.Text = newText
        ' 重新添加书签，避免替换后丢失
        doc.Bookmarks.Add bookmarkName, rng
    End If
End Sub

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