检查文档中的字幕格式是否一致并更新设置格式

Question

我在许多论坛上花了很多时间试图拼凑代码来检查文档中的每个标题是否具有与下面相同的格式。我已经为表格和图形设置了“表格标题”样式，为照片设置了“照片”样式，但我无法将数字后面的冒号默认为样式的一部分，也无法在说明中添加选项卡。编号应该链接到章节，因此也需要检查/更新。

我能够遍历标题，但无法弄清楚要放入哪些代码来强制格式保持一致，而不替换描述中的现有文本。如果添加或删除标题，某些标题将缺少冒号和选项卡，而其他标题将不会更新数字

这是我希望在图下方居中且在表格上方居中的格式，但它被称为表 4-1

这是我想要在照片下方居中的格式

这就是我用来迭代字幕的方法，它成功地找到了每个字幕。我能够识别标题，只是不知道如何构建代码以在找到它们后对其进行格式化。

Public Sub IterateCaptions()
Dim oField As Field
Dim sCode As String
Dim bFoundOne As String

For Each oField In ActiveDocument.Fields
If oField.Type = wdFieldSequence Then
bFoundOne = False
sCode = oField.Code

'see if it's a caption sequence field
If InStr(sCode, "Table") <> 0 Then
bFoundOne = True
End If
'see if it's a caption sequence field
If InStr(sCode, "Equation") <> 0 Then
bFoundOne = True
End If
'see if it's a caption sequence field
If InStr(sCode, "Figure") <> 0 Then
bFoundOne = True
End If
'now what?
If bFoundOne Then
oField.Select
Stop
End If
End If
Next
End Sub

我曾尝试添加此内容，但这仍然对我使用冒号和制表符进行描述没有帮助；

 With CaptionLabels("Table")
    .NumberStyle = wdCaptionNumberStyleArabic
        .IncludeChapterNumber = True
        .ChapterStyleLevel = 1
        .Separator = wdSeparatorHyphen
    .IncludeChapterNumber = True
  
  
 With CaptionLabels("Figure")
    .NumberStyle = wdCaptionNumberStyleArabic
        .IncludeChapterNumber = True
        .ChapterStyleLevel = 1
        .Separator = wdSeparatorHyphen
    .IncludeChapterNumber = True
    
    
 With CaptionLabels("Photo")
    .NumberStyle = wdCaptionNumberStyleArabic
        .IncludeChapterNumber = True
        .ChapterStyleLevel = 1
        .Separator = wdSeparatorHyphen
    .IncludeChapterNumber = False

如果我没有提供足够的细节，我很抱歉，但我在这个问题上迷失了很多兔子洞，所以我希望有人能为我提供一些指导。

Answer 1

尝试这样的事情：

Sub FindCaptions()
    Dim findRng As Range: Set findRng = ActiveDocument.Content
    With findRng
        With .Find
        .ClearFormatting
        .Replacement.ClearFormatting
        .Format = True
        .Style = wdStyleCaption
        .Forward = True
        .Wrap = wdFindStop
        End With
        Do While .Find.Execute
            'move start beyond caption label
            .MoveStart wdWord, 2
            If Not Left(.Text, 2) = ":" & vbTab Then
                .InsertBefore ":" & vbTab
            End If
            .Collapse wdCollapseEnd
        Loop
    End With
End Sub