Word模板修改：一键解决自定义题注消失及格式问题

1.定位默认模板文件路径
模板文件通常位于 C:\Users\[用户名]\AppData\Roaming\Microsoft\Templates 目录下。打开资源管理器，导航至该路径，找到 Normal.dotm 文件。

2.编辑模板文件
右键点击 Normal.dotm 文件，选择用 Microsoft Word 打开。确保以管理员权限运行 Word 以避免权限问题。

3.添加宏代码
进入 Word 后，点击顶部菜单栏的「开发工具」选项卡。若未显示该选项卡，需在 Word 选项中启用「开发工具」功能。选择「宏」→「录制宏」，任意命名后立即停止录制。再次进入「宏」界面，选择刚创建的宏名称（如"宏1"），点击「编辑」打开 VBA 编辑器。

4.替换并保存代码
在 VBA 编辑器中删除自动生成的代码，粘贴以下修改题注格式的宏代码：

'==========================
' 安全版：移动中文题注空格位置
' 将“图 1”改为“图1 ”
' 将“表 1”改为“表1 ”
' 不破坏题注中的 SEQ 域
'==========================
Sub InsertCaption()

    Dim startPt As Long
    Dim endPt As Long
    Dim captionLabel As String
    Dim rngCap As Range
    Dim rngFind As Range
    Dim fld As Field
    Dim foundField As Boolean
    Dim rngAfterLabel As Range
    Dim rngAfterField As Range

    ' 记录插入前位置
    startPt = Selection.Start

    ' 调出 Word 自带题注对话框
    If Dialogs(wdDialogInsertCaption).Show = -1 Then

        ' 插入后位置
        endPt = Selection.Start

        ' 获取刚插入的题注范围
        Set rngCap = ActiveDocument.Range(Start:=startPt, End:=endPt)

        ' 只处理“图”“表”
        captionLabel = ""
        If Left(Replace(rngCap.Text, vbCr, ""), 1) = "图" Then
            captionLabel = "图"
        ElseIf Left(Replace(rngCap.Text, vbCr, ""), 1) = "表" Then
            captionLabel = "表"
        Else
            Exit Sub
        End If

        '--------------------------------
        ' 第一步：删除“标签”和“编号域”之间的空格
        ' 即把“图 1”改成“图1”
        '--------------------------------
        Set rngAfterLabel = ActiveDocument.Range( _
            Start:=rngCap.Start + Len(captionLabel), _
            End:=rngCap.Start + Len(captionLabel) + 1)

        If rngAfterLabel.Text = " " Then
            rngAfterLabel.Delete
        End If

        ' 删除空格后，重新获取题注范围
        endPt = Selection.Start
        Set rngCap = ActiveDocument.Range(Start:=startPt, End:=endPt)

        '--------------------------------
        ' 第二步：找到题注中的 SEQ 域
        '--------------------------------
        foundField = False
        For Each fld In rngCap.Fields
            If InStr(1, fld.Code.Text, "SEQ", vbTextCompare) > 0 Then
                foundField = True
                Exit For
            End If
        Next fld

        If Not foundField Then Exit Sub

        '--------------------------------
        ' 第三步：确保“编号后面”有一个空格
        ' 即把“图1标题”改成“图1 标题”
        ' 或“图1”改成“图1 ”
        '--------------------------------
        Set rngAfterField = ActiveDocument.Range(Start:=fld.Result.End, End:=fld.Result.End + 1)

        ' 如果编号后不是空格，则插入一个空格
        If rngAfterField.Text <> " " Then
            ActiveDocument.Range(Start:=fld.Result.End, End:=fld.Result.End).InsertAfter " "
        End If

        '--------------------------------
        ' 第四步：把光标移到编号后的空格后，方便继续输入标题
        '--------------------------------
        Selection.Start = fld.Result.End + 1
        Selection.End = Selection.Start

    End If

End Sub

'==========================
' 主程序：自动创建题注标签
'==========================
Sub AutoCreateCaptionLabels()

    Dim labels As Variant   ' 定义一个数组，用来存放需要创建的标签名称
    Dim lbl As Variant      ' 用于循环中的单个标签变量
    
    ' 定义需要创建的题注标签（中英文混合）注意：英文标签后添加了一个空格，根据个人需要可自定义。
    labels = Array("Fig.", "图", "表")    'labels = Array("Fig.", "图", "表")
    
    ' 遍历每一个标签
    For Each lbl In labels
    
        ' 如果该标签不存在
        If Not LabelExists(CStr(lbl)) Then
        
            ' 在 Word 中创建该题注标签
            Application.CaptionLabels.Add Name:=CStr(lbl)
            
        End If
        
    Next lbl

End Sub


'==========================
' 函数：判断标签是否存在
'==========================
Function LabelExists(labelName As String) As Boolean

    Dim cl As captionLabel   ' 定义一个题注标签对象
    
    LabelExists = False      ' 默认设为不存在
    
    ' 遍历 Word 当前所有题注标签
    For Each cl In Application.CaptionLabels
    
        ' 比较标签名称（忽略大小写）
        If StrComp(cl.Name, labelName, vbTextCompare) = 0 Then
        
            LabelExists = True   ' 如果找到，标记为存在
            
            Exit Function        ' 立即退出函数（提高效率）
            
        End If
        
    Next cl

End Function


'==========================
' 自动宏：打开已有文档时触发
'==========================
Sub AutoOpen()

    ' 调用主程序，自动创建标签
    AutoCreateCaptionLabels

End Sub


'==========================
' 自动宏：新建文档时触发
'==========================
Sub AutoNew()

    ' 调用主程序，自动创建标签
    AutoCreateCaptionLabels

End Sub

关闭 VBA 编辑器并保存 Normal.dotm 文件。退出 Word 时确保选择保存对模板的更改。

验证修改效果

新建 Word 文档测试功能
关闭所有 Word 窗口后重新启动 Word，新建空白文档。检查题注样式是否已按代码要求修改为宋体、居中对齐。插入题注时，中文与编号之间的空格应自动调整。

处理权限问题
若保存失败，可能是权限限制。可将模板文件复制到桌面，修改完成后再覆盖回原目录，或直接以管理员身份运行 Word。