搜索选定的文本并格式化为多个带标题的表格

Question

较长的 MS Word 文档中间有文本，需要转换为多个表格，每个表格都有一个标题。

我已经编写了代码，在其中选择标题句子，运行宏并对其进行格式化。
然后我可以选择另一部分文本，运行另一个宏，它会转换为表格并格式化。
我对每个标题/表格组合都这样做。

我想选择所有文本，运行一个宏，然后它会被转换/格式化为多个标题和表格。

我正在考虑在每个标题和每个表格部分的开头放置唯一字符（例如下面示例中的@@@和###）。
我正在努力解决如何浏览选定的文本，找到要执行操作的独特字符并移动到下一个独特字符。

如果您除了使用这些独特的角色之外还有其他想法，我们也欢迎。

A whole bunch of text.
@@@This is a header
###This is text to format & convert to a table
@@@This is a header
###This is text to format & convert to a table
@@@This is a header
###This is text to format & convert to a table
@@@This is a header
###This is text to format & convert to a table
A whole bunch of text.

将选择内容转换为表格的代码。

Sub textToTable()

    Selection.ConvertToTable Separator:=wdSeparateByDefaultListSeparator, _
        NumColumns:=5, NumRows:=6, AutoFitBehavior:=wdAutoFitFixed
    With Selection.Tables(1)
        .Style = "Table Grid"
        .ApplyStyleHeadingRows = True
        .ApplyStyleLastRow = False
        .ApplyStyleFirstColumn = True
        .ApplyStyleLastColumn = False
    End With

    Selection.Tables(1).Rows(3).Cells.Merge
    Selection.Tables(1).Rows(4).Cells.Merge
    Selection.Tables(1).Rows(5).Cells.Merge
    Selection.Tables(1).Rows(6).Cells.Merge

    Selection.Tables(1).Rows(1).Shading.Texture = wdTextureNone
    Selection.Tables(1).Rows(1).Shading.ForegroundPatternColor = wdColorAutomatic
    Selection.Tables(1).Rows(1).Shading.BackgroundPatternColor = -603923969

    Selection.Tables(1).Rows(3).Shading.Texture = wdTextureNone
    Selection.Tables(1).Rows(3).Shading.ForegroundPatternColor = wdColorAutomatic
    Selection.Tables(1).Rows(3).Shading.BackgroundPatternColor = -603923969

    Selection.Tables(1).Rows(5).Shading.Texture = wdTextureNone
    Selection.Tables(1).Rows(5).Shading.ForegroundPatternColor = wdColorAutomatic
    Selection.Tables(1).Rows(5).Shading.BackgroundPatternColor = -603923969
    
    Selection.Tables(1).Rows(1).Select
    Selection.Font.Bold = True
    Selection.Tables(1).Rows(3).Select
    Selection.Font.Bold = True
    Selection.Tables(1).Rows(5).Select
    Selection.Font.Bold = True

    ' Remove return characters
    Selection.Tables(1).Rows(6).Select
    tempString = Selection.Range.Text
    Selection.Range.Text = Left(tempString, Len(tempString) - 5)
End Sub

格式化标题的代码。

Sub Heading()    
    Selection.Font.Italic = True
    Selection.Range.Font.TextColor.RGB = RGB(97, 146, 0)
    temp = Selection.Range.Text
    Selection.Range.Text = Right(temp, Len(temp) - 1)     
End Sub

这是运行两个宏之前文本的样子。该文本可以在我的 Word 文档中重复 1 到 n 次：

这就是我最终格式化的表格在 Word 中的样子：

Answer 1

@@@

是起跑线的制作者。代码自动转换标题标题（一段）和表格（六段）。

注意：一行（单元格）中可以有多个句子。但它应该在一个段落中。

Option Explicit
Sub SearchTab()
    Application.DefaultTableSeparator = "*"
    Selection.HomeKey unit:=wdStory
    With Selection.Find
        .Text = "@@@"
        .Forward = True
        .Wrap = wdFindStop
        .Format = False
        .MatchAllWordForms = False
        Do While .Execute
            With Selection
                .Delete
                .Expand wdParagraph
                .Font.Italic = True
                .Range.Font.TextColor.RGB = RGB(97, 146, 0)
                .MoveDown unit:=wdParagraph
                .MoveDown unit:=wdParagraph, Count:=6, Extend:=wdExtend
                Call textToTable
                .Collapse wdCollapseEnd
            End With
        Loop
    End With
End Sub
Sub textToTable()
    Dim tempString As String, i As Integer
    Selection.ConvertToTable Separator:=wdSeparateByDefaultListSeparator, _
        NumColumns:=5, NumRows:=6, AutoFitBehavior:=wdAutoFitFixed
    With Selection.Tables(1)
        .Style = "Table Grid"
        .ApplyStyleHeadingRows = True
        .ApplyStyleLastRow = False
        .ApplyStyleFirstColumn = True
        .ApplyStyleLastColumn = False
        For i = 1 To .Rows.Count
            If i > 2 Then .Rows(i).Cells.Merge
            If Int(i / 2) <> i / 2 Then
                .Rows(i).Shading.Texture = wdTextureNone
                .Rows(i).Shading.ForegroundPatternColor = wdColorAutomatic
                .Rows(i).Shading.BackgroundPatternColor = -603923969
                .Rows(i).Range.Font.Bold = True
            End If
        Next
    End With
End Sub