求助：Word文档题注格式统一化VBA代码完善方案

Step 1: Correct Caption Label Numbering Settings #

First, fix the caption label configurations to ensure new captions use chapter-linked numbering correctly. This resolves duplicate settings and missing closure statements from your original code:

Sub ConfigureCaptionLabels()
    ' Configure Table captions (chapter-linked, e.g., Table 4-1)
    With CaptionLabels("Table")
        .NumberStyle = wdCaptionNumberStyleArabic
        .IncludeChapterNumber = True
        .ChapterStyleLevel = 1
        .Separator = wdSeparatorHyphen
    End With
    
    ' Configure Figure captions (chapter-linked)
    With CaptionLabels("Figure")
        .NumberStyle = wdCaptionNumberStyleArabic
        .IncludeChapterNumber = True
        .ChapterStyleLevel = 1
        .Separator = wdSeparatorHyphen
    End With
    
    ' Configure Photo captions (no chapter number)
    With CaptionLabels("Photo")
        .NumberStyle = wdCaptionNumberStyleArabic
        .IncludeChapterNumber = False
        .Separator = wdSeparatorHyphen
    End With
End Sub

Step 2: Update Existing Captions to Match Required Format #

This macro processes all existing captions to fix missing colons/tabs, sync numbering, apply correct styles, and ensure proper placement:

Sub FixAllCaptions()
    Dim oField As Field
    Dim captionRange As Range
    Dim captionType As String
    Dim hasColonTab As Boolean
    
    ' Sync all field numbers first to reflect chapter changes
    ActiveDocument.Fields.Update
    
    For Each oField In ActiveDocument.Fields
        If oField.Type = wdFieldSequence Then
            ' Identify caption type
            captionType = ""
            If InStr(oField.Code, "Table") > 0 Then
                captionType = "Table"
            ElseIf InStr(oField.Code, "Figure") > 0 Then
                captionType = "Figure"
            ElseIf InStr(oField.Code, "Photo") > 0 Then
                captionType = "Photo"
            End If
            
            If captionType <> "" Then
                Set captionRange = oField.Result.Duplicate
                captionRange.Expand wdParagraph ' Cover entire caption line
                
                ' Check if colon + tab exist after the number field
                captionRange.Start = oField.Result.End
                captionRange.End = captionRange.Paragraphs(1).Range.End - 1 ' Exclude paragraph mark
                
                hasColonTab = False
                If Trim(captionRange.Text) <> "" Then
                    If Left(Trim(captionRange.Text), 1) = ":" And InStr(captionRange.Text, vbTab) > 0 Then
                        hasColonTab = True
                    End If
                End If
                
                ' Insert colon + tab if missing
                If Not hasColonTab Then
                    oField.Result.InsertAfter ": " & vbTab
                End If
                
                ' Apply correct style and enforce placement
                Select Case captionType
                    Case "Table", "Figure"
                        captionRange.Paragraphs(1).Style = ActiveDocument.Styles("Table Figure Caption")
                        ' Ensure Table captions are above their table
                        If captionType = "Table" Then
                            If captionRange.Previous(wdParagraph).Tables.Count > 0 Then
                                captionRange.Paragraphs(1).Range.Cut
                                captionRange.Previous(wdParagraph).Range.PasteBefore
                            End If
                        End If
                    Case "Photo"
                        captionRange.Paragraphs(1).Style = ActiveDocument.Styles("Photo")
                        ' Ensure Photo captions are below their image
                        If captionRange.Next(wdParagraph).Range.InlineShapes.Count > 0 Then
                            captionRange.Paragraphs(1).Range.Cut
                            captionRange.Next(wdParagraph).Range.PasteAfter
                        End If
                End Select
                
                ' Force centered alignment (matches your style requirement)
                captionRange.Paragraphs(1).Alignment = wdAlignParagraphCenter
                
                ' Update the field to ensure correct numbering
                oField.Update
            End If
        End If
    Next oField
End Sub

How to Use #

1. Open your Word document and press Alt + F11 to open the VBA Editor.
2. Insert a new module (Insert > Module).
3. Paste both macros into the module.
4. Run ConfigureCaptionLabels first to set up default caption behavior.
5. Run FixAllCaptions to update all existing captions in the document.

Notes #

• Ensure your "Table Figure Caption" and "Photo" styles are configured with the correct font, spacing, etc. The macro enforces centering but relies on your style definitions for other formatting.
• The placement logic checks adjacent paragraphs for tables/images. For complex layouts (e.g., captions in text boxes), you may need manual adjustments.
• Always back up your document before running macros to avoid accidental data loss.

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