Word通过宏统一设置样式

Word通过宏统一设置表格样式、图片样式、标题和正文样式、更新目录。

Sub A表格格式化_增强版()
    On Error Resume Next
    Application.ScreenUpdating = False
    Dim tbl As table
    Dim counter As Integer: counter = 1
    Dim response As VbMsgBoxResult
    
    For Each tbl In ActiveDocument.Tables
        Call FormatSingleTable(tbl)
        
        ' 进度提示
        If counter Mod 20 = 0 Then
            response = MsgBox("已处理第 " & counter & " 个表格", vbOKCancel + vbInformation, "进度")
            If response = vbCancel Then Exit For
        End If
        counter = counter + 1
    Next tbl
    
    Application.ScreenUpdating = True
    If response <> vbCancel Then
        MsgBox "完成！共处理 " & (counter - 1) & " 个表格", vbInformation
    End If
End Sub

' 单独处理每个表格的函数
Sub FormatSingleTable(tbl As table)
    On Error Resume Next
    
    ' 表格基本设置
    With tbl
        .PreferredWidthType = wdPreferredWidthPercent
        .PreferredWidth = 100
        .AllowAutoFit = False
        .Rows.Alignment = wdAlignRowCenter
    End With
    
    ' 边框设置
    With tbl.Borders
        .Enable = True
        .OutsideLineStyle = wdLineStyleSingle
        .OutsideLineWidth = wdLineWidth050pt
        .InsideLineStyle = wdLineStyleSingle
        .InsideLineWidth = wdLineWidth050pt
    End With
    
    ' 逐个单元格处理（支持合并单元格）
    Dim r As Long, c As Long
    For r = 1 To tbl.Rows.Count
        For c = 1 To tbl.Columns.Count
            ' 只处理每个合并区域的第一个单元格
            If Not IsMergedCell(tbl, r, c) Then
                FormatTableCell tbl, r, c
            End If
        Next c
    Next r
End Sub

' 判断是否为合并单元格的重复部分
Function IsMergedCell(tbl As table, row As Long, col As Long) As Boolean
    On Error Resume Next
    IsMergedCell = (tbl.cell(row, col).rowIndex <> row Or tbl.cell(row, col).ColumnIndex <> col)
End Function

' 格式化单个单元格
Sub FormatTableCell(tbl As table, row As Long, col As Long)
    On Error Resume Next
    With tbl.cell(row, col)
        .VerticalAlignment = wdCellAlignVerticalCenter
        .Range.ParagraphFormat.Alignment = wdAlignParagraphCenter
        .Range.Font.Name = "宋体"
        .Range.Font.NameFarEast = "宋体"
        .Range.Font.Size = 10.5
        .Range.Font.Color = RGB(0, 0, 0)
        
        If row = 1 Then
            .Range.Font.Bold = True
            .Shading.BackgroundPatternColor = RGB(242, 242, 242)
        Else
            .Range.Font.Bold = False
            .Shading.BackgroundPatternColor = wdColorAutomatic
        End If
    End With
End Sub


'' 厘米转磅函数（1厘米=28.35磅）
Function CentimetersToPoints(ByVal cm As Single) As Single
    CentimetersToPoints = cm * 28.35
End Function



Sub B图片格式化()
    ' 声明变量
    Dim shp As Shape
    Dim ilshp As InlineShape
    Dim pageWidth As Single
    Dim leftMargin As Single
    Dim rightMargin As Single
    Dim usableWidth As Single
    
    ' 关闭屏幕更新以提高宏运行速度
    Application.ScreenUpdating = False
    
    ' 设置错误处理，跳过无法处理的图片
    On Error Resume Next
    
    ' 计算页面可用宽度（点数）
    With ActiveDocument.PageSetup
        pageWidth = .pageWidth
        leftMargin = .leftMargin
        rightMargin = .rightMargin
    End With
    
    ' 计算可用宽度 = 页面宽度 - 左边距 - 右边距
    usableWidth = pageWidth - leftMargin - rightMargin
    
    ' 第一部分：处理嵌入型图片（InlineShapes）
    For Each ilshp In ActiveDocument.InlineShapes
        If ilshp.Type = wdInlineShapePicture Or ilshp.Type = wdInlineShapeLinkedPicture Then
            ' 设置图片宽度为页面可用宽度
            ilshp.Width = usableWidth
            ' ★ 新增：取消首行缩进并设置居中对齐
            With ilshp.Range.ParagraphFormat
                .CharacterUnitFirstLineIndent = 0    ' 取消字符单位首行缩进
                .FirstLineIndent = 0                 ' 取消磅单位首行缩进
                .Alignment = wdAlignParagraphCenter   ' 段落后中包括图片
            End With
        End If
    Next ilshp
    
    ' 第二部分：处理浮动型图片（Shapes）
    For Each shp In ActiveDocument.Shapes
        If shp.Type = msoPicture Or shp.Type = msoLinkedPicture Then
            ' 锁定纵横比，设置宽度为页面可用宽度
            shp.LockAspectRatio = msoTrue
            shp.Width = usableWidth
            ' ★ 新增：通过锚定段落取消首行缩进并居中对齐
            If Not shp.Anchor Is Nothing Then
                With shp.Anchor.ParagraphFormat
                    .CharacterUnitFirstLineIndent = 0
                    .FirstLineIndent = 0
                    .Alignment = wdAlignParagraphCenter
                End With
            End If
        End If
    Next shp
    
    ' 完成提示（更新提示文本）
    MsgBox "图片设置已完成！" & vbCrLf & vbCrLf & _
           "所有图片已设置为页面宽度、居中对齐，并取消首行缩进。", _
           vbInformation, "图片样式设置"
    
    ' 重新开启屏幕更新
    Application.ScreenUpdating = True
End Sub



Sub C设置正文样式()
    ' 关闭屏幕更新和响应提示以提高宏运行速度
    Application.ScreenUpdating = False
    Application.DisplayAlerts = wdAlertsNone
    
    Dim para As Paragraph
    
    ' 遍历文档中的所有段落
    For Each para In ActiveDocument.Paragraphs
        ' 判断段落样式并应用相应格式
        Select Case para.style
            Case "正文"
                With para.Range.Font
                    .Name = "宋体"
                    .Size = 12    ' 小四号对应12磅
                    .Color = RGB(0, 0, 0) ' 黑色
                    .Bold = False
                    .Italic = False
                End With
                
                ' ★ 新增：检查段落是否包含图片或表格，不进行缩进
                If para.Range.InlineShapes.Count = 0 And para.Range.Tables.Count = 0 Then
                    With para.Range.ParagraphFormat
                        .LineSpacingRule = wdLineSpace1pt5  ' 1.5倍行距
                        .SpaceBefore = 0
                        .SpaceAfter = 0
                        .CharacterUnitFirstLineIndent = 2   ' 首行缩进2个字符
                    End With
                Else
                    ' 对于包含图片或表格的段落，只设置基本段落格式，不缩进
                    With para.Range.ParagraphFormat
                        .LineSpacingRule = wdLineSpace1pt5
                        .SpaceBefore = 0
                        .SpaceAfter = 0
                        .CharacterUnitFirstLineIndent = 0   ' 取消缩进
                        .FirstLineIndent = 0                ' 取消磅单位缩进
                    End With
                    
                    ' 设置表格的字体为五号
                    With para.Range.Font
                        .Name = "宋体"
                        .Size = 10.5             ' 五号对应10.5磅
                        .Color = RGB(0, 0, 0)    ' 黑色
                        .Bold = False
                        .Italic = False
                    End With
                    
                End If
        End Select
    Next para
    
    ' 恢复屏幕更新和提示
    Application.ScreenUpdating = True
    Application.DisplayAlerts = wdAlertsAll
    
    ' 弹窗显示设置结果
    MsgBox "正文设置已完成！" & vbCrLf & vbCrLf & _
           "正文:  宋体，小四(12磅)，1.5倍行距" & vbCrLf & _
           "       普通段落：首行缩进2字符" & vbCrLf & _
           "       图片/表格段落：无缩进", _
           vbInformation, "正文样式设置"
End Sub


Sub D清除现有列表样式()

    ' 清除选定区域或全文的现有列表格式
    If Selection.Range.Start = Selection.Range.End Then
        ' 如果未选中任何内容，则处理整个文档
        ActiveDocument.Range.ListFormat.RemoveNumbers
    Else
        ' 如果已选中内容，则处理选中部分
        Selection.Range.ListFormat.RemoveNumbers
    End If

    ' 弹窗显示设置结果
    MsgBox "样式已清除！", _
           vbInformation, "清除样式设置"

End Sub


Sub F带中文编号的多级列表()

    Dim listTemplate As listTemplate
    Set listTemplate = ActiveDocument.ListTemplates.Add(OutlineNumbered:=True)
    
    With listTemplate
        ' 第1级：第一章
        With .ListLevels(1)
            .NumberFormat = "第%1章"                   ' 设置编号格式为"第1章"等形式，%1代表第一级数字
            .NumberStyle = wdListNumberStyleArabic     ' 设置编号样式为阿拉伯数字
            .LinkedStyle = "标题 1"                    ' 将此列表级别链接到"标题 1"样式
            .NumberPosition = 0                        ' 设置编号的悬挂缩进位置（单位为磅）
            .TextPosition = 54                         ' 设置文本的缩进位置（单位为磅）
            .StartAt = 1                               ' 设置起始编号为1
            .TrailingCharacter = wdTrailingSpace       ' 设置编号后的尾随字符为空格（与文本分隔）
        End With
        
        ' 第2级：1.1
        With .ListLevels(2)
            .NumberFormat = "%1.%2"
            .NumberStyle = wdListNumberStyleArabic
            .LinkedStyle = "标题 2"
            .NumberPosition = 54
            .TextPosition = 90
            .StartAt = 1
            .TrailingCharacter = wdTrailingSpace
            .ResetOnHigher = 1
        End With
        
        ' 第3级：1.1.1
        With .ListLevels(3)
            .NumberFormat = "%1.%2.%3"
            .NumberStyle = wdListNumberStyleArabic
            .LinkedStyle = "标题 3"
            .NumberPosition = 90
            .TextPosition = 126
            .StartAt = 1
            .TrailingCharacter = wdTrailingSpace
            .ResetOnHigher = 2
        End With
        
        ' 第4级：1.1.1.1
        With .ListLevels(4)
            .NumberFormat = "%1.%2.%3.%4"
            .NumberStyle = wdListNumberStyleArabic
            .LinkedStyle = "标题 4"
            .NumberPosition = 126
            .TextPosition = 162
            .StartAt = 1
            .TrailingCharacter = wdTrailingSpace
            .ResetOnHigher = 3
        End With
        
        
        ' 第5级: 1.1.1.1.1
        With .ListLevels(5)
            .NumberFormat = "%1.%2.%3.%4.%5"
            .NumberStyle = wdListNumberStyleArabic
            .LinkedStyle = "标题 5"
            .NumberPosition = 162
            .TextPosition = 198
            .StartAt = 1
            .TrailingCharacter = wdTrailingSpace
            .ResetOnHigher = 4
        End With
        
        ' 第6级：(1)
        With .ListLevels(6)
            .NumberFormat = "(%6)"
            .NumberStyle = wdListNumberStyleArabic
            .LinkedStyle = "标题 6"
            .NumberPosition = 198
            .TextPosition = 234
            .StartAt = 1
            .TrailingCharacter = wdTrailingSpace
            .ResetOnHigher = 5
        End With
        
    End With

    
    ' 设置标题样式的字体格式
    SetHeadingStylesFormat
    
    
    ' 遍历所有段落，应用标题样式
    For Each para In ActiveDocument.Paragraphs
        If para.style Like "标题 *" Then
            Dim level As Integer
            level = Val(Right(para.style, 1))
            
            ' 保存原始对齐方式
            originalAlignment = para.Range.ParagraphFormat.Alignment
            
            If level >= 1 And level <= 6 Then
                ' 应用对应的中文标题样式
                para.style = ActiveDocument.Styles("标题 " & level)
            End If
            
            ' 恢复原始对齐方式
            para.Range.ParagraphFormat.Alignment = originalAlignment
            
        End If
    Next para
    
    MsgBox "标题样式设置完成！", vbInformation, "标题样式设置"
    
End Sub


' 设置标题样式的字体格式
Function SetHeadingStylesFormat()
    On Error Resume Next
    
    ' 标题1样式设置：第一章
    With ActiveDocument.Styles("标题 1").Font
        .Name = "黑体"                   ' 字体
        .Size = 22                       ' 字号 二号
        .Bold = True                     ' 加粗
        .Color = RGB(0, 0, 0)            ' 黑色
        .Italic = False                  ' 非斜体
        .Underline = wdUnderlineNone     ' 无下划线
    End With
    With ActiveDocument.Styles("标题 1").ParagraphFormat
        .Alignment = wdAlignParagraphLeft    ' 左对齐
        .LineSpacingRule = wdLineSpaceSingle ' 单倍行距
        .SpaceBefore = 12                ' 段前间距
        .SpaceAfter = 6                  ' 段后间距
        ' 关键：设置所有缩进为0
        .LeftIndent = 0
        .RightIndent = 0
        .FirstLineIndent = 0
        .CharacterUnitLeftIndent = 0
        .CharacterUnitRightIndent = 0
        .CharacterUnitFirstLineIndent = 0
    End With
    
    ' 标题2样式设置：1.1
    With ActiveDocument.Styles("标题 2").Font
        .Name = "黑体"
        .Size = 16                       ' 字体 三号
        .Bold = True
        .Color = RGB(0, 0, 0)            ' 黑色
        .Italic = False
    End With
    With ActiveDocument.Styles("标题 2").ParagraphFormat
        .Alignment = wdAlignParagraphLeft    ' 左对齐
        .LineSpacingRule = wdLineSpaceSingle
        .SpaceBefore = 12
        .SpaceAfter = 6
        .FirstLineIndent = 0             ' 首行不缩进
        ' 关键：设置所有缩进为0
        .LeftIndent = 0
        .RightIndent = 0
        .FirstLineIndent = 0
        .CharacterUnitLeftIndent = 0
        .CharacterUnitRightIndent = 0
        .CharacterUnitFirstLineIndent = 0
    End With
    
    ' 标题3样式设置：1.1.1
    With ActiveDocument.Styles("标题 3").Font
        .Name = "宋体"
        .Size = 14                      ' 字体 四号
        .Bold = True
        .Color = RGB(0, 0, 0)
        .Italic = False
    End With
    With ActiveDocument.Styles("标题 3").ParagraphFormat
        .Alignment = wdAlignParagraphLeft
        .LineSpacingRule = wdLineSpaceSingle
        .SpaceBefore = 6
        .SpaceAfter = 3
        .FirstLineIndent = 0
        ' 关键：设置所有缩进为0
        .LeftIndent = 0
        .RightIndent = 0
        .FirstLineIndent = 0
        .CharacterUnitLeftIndent = 0
        .CharacterUnitRightIndent = 0
        .CharacterUnitFirstLineIndent = 0
    End With
    
    ' 标题4样式设置：1.1.1.1
    With ActiveDocument.Styles("标题 4").Font
        .Name = "宋体"
        .Size = 12                  '字体 小四
        .Bold = True
        .Color = RGB(0, 0, 0)
        .Italic = False
    End With
    With ActiveDocument.Styles("标题 4").ParagraphFormat
        .Alignment = wdAlignParagraphLeft
        .LineSpacingRule = wdLineSpaceSingle
        .SpaceBefore = 6
        .SpaceAfter = 3
        .FirstLineIndent = 0
        ' 关键：设置所有缩进为0
        .LeftIndent = 0
        .RightIndent = 0
        .FirstLineIndent = 0
        .CharacterUnitLeftIndent = 0
        .CharacterUnitRightIndent = 0
        .CharacterUnitFirstLineIndent = 0
    End With
    
    ' 标题5样式设置：1.1.1.1.1
    With ActiveDocument.Styles("标题 5").Font
        .Name = "宋体"
        .Size = 12                       ' 字体 小四
        .Bold = False                    ' 不加粗
        .Color = RGB(0, 0, 0)
        .Italic = False
    End With
    With ActiveDocument.Styles("标题 5").ParagraphFormat
        .Alignment = wdAlignParagraphLeft
        .LineSpacingRule = wdLineSpaceSingle
        .SpaceBefore = 3
        .SpaceAfter = 3
        .FirstLineIndent = 0
        ' 关键：设置所有缩进为0
        .LeftIndent = 0
        .RightIndent = 0
        .FirstLineIndent = 0
        .CharacterUnitLeftIndent = 0
        .CharacterUnitRightIndent = 0
        .CharacterUnitFirstLineIndent = 0
    End With
    
    ' 标题6样式设置：(1)
    With ActiveDocument.Styles("标题 6").Font
        .Name = "宋体"
        .Size = 12
        .Bold = False
        .Color = RGB(0, 0, 0)
        .Italic = False
    End With
    With ActiveDocument.Styles("标题 6").ParagraphFormat
        .Alignment = wdAlignParagraphLeft
        .LineSpacingRule = wdLineSpaceSingle
        .SpaceBefore = 3
        .SpaceAfter = 3
        .FirstLineIndent = 0
        ' 关键：设置所有缩进为0
        .LeftIndent = 0
        .RightIndent = 0
        .FirstLineIndent = 0
        .CharacterUnitLeftIndent = 0
        .CharacterUnitRightIndent = 0
        .CharacterUnitFirstLineIndent = 0
    End With
    
    On Error GoTo 0
End Function


' 创建目录样式，并刷新目录
Sub G刷新目录()
    On Error Resume Next
    Application.ScreenUpdating = False
    
    Dim originalRange As Range
    Set originalRange = Selection.Range
    
    ' 检查是否存在目录
    If ActiveDocument.TablesOfContents.Count = 0 Then
        If MsgBox("文档中没有找到目录，是否创建目录？", vbYesNo + vbQuestion, "创建目录") = vbYes Then
            CreateTOC
        Else
            Application.ScreenUpdating = True
            Exit Sub
        End If
    End If
    
    ' 设置目录样式
    SetAllTOCStyles
    
    ' 刷新目录
    UpdateAllTOC
    
    ' 返回原位置
    originalRange.Select
    
    Application.ScreenUpdating = True
    MsgBox "目录样式设置完成！" & vbCrLf & _
           "字体：宋体" & vbCrLf & _
           "字号：小四（12磅）", vbInformation, "目录格式设置"
End Sub

' 创建目录（在第2页）
Function CreateTOC()
    ' 移动到文档开头
    Selection.HomeKey Unit:=wdStory
    
    ' 如果文档页数不足2页，则插入分页符直到有第2页
    If ActiveDocument.ComputeStatistics(wdStatisticPages) < 2 Then
        Selection.InsertBreak Type:=wdPageBreak
    End If
    
    ' 移动到第1页开头
    MoveToPage 1
    
    ' 插入分页符，确保目录从新页面开始（如果需要）
    If Selection.Information(wdActiveEndPageNumber) <> 2 Then
        Selection.InsertBreak Type:=wdPageBreak
        MoveToPage 2
    End If
    
    ' 添加"目录"标题
    Selection.style = ActiveDocument.Styles("标题 1")
    Selection.TypeText text:="目录"
    Selection.TypeParagraph
    
    ' 插入目录字段
    ActiveDocument.TablesOfContents.Add _
        Range:=Selection.Range, _
        RightAlignPageNumbers:=True, _
        UseHeadingStyles:=True, _
        UpperHeadingLevel:=1, _
        LowerHeadingLevel:=3, _
        IncludePageNumbers:=True, _
        UseHyperlinks:=True, _
        AddedStyles:="", _
        UseFields:=True, _
        TableID:=""
    
    ' 在目录后添加分页符，确保后续内容从新页面开始
    Selection.InsertBreak Type:=wdPageBreak
    
End Function

' 跳转到指定页码
Function MoveToPage(pageNumber As Integer)
    On Error Resume Next
    Selection.GoTo What:=wdGoToPage, Which:=wdGoToNext, Name:=pageNumber
End Function

' 设置所有目录样式
Function SetAllTOCStyles()
    Dim i As Integer
    Dim style As style
    
    ' 设置1-9级目录样式
    For i = 1 To 9
        SetTOCStyleWithLevel "目录 " & i, "宋体", 12
        SetTOCStyleWithLevel "TOC " & i, "宋体", 12
    Next i
End Function

' 设置带级别的目录样式
Function SetTOCStyleWithLevel(styleName As String, fontName As String, fontSize As Single)
    On Error Resume Next
    Dim style As style
    
    Set style = ActiveDocument.Styles(styleName)
    If Not style Is Nothing Then
        With style.Font
            .Name = fontName
            .NameFarEast = fontName
            .Size = fontSize
        End With
        
        ' 设置缩进（根据级别）
        With style.ParagraphFormat
            .LeftIndent = CentimetersToPoints(0)
            .FirstLineIndent = CentimetersToPoints(0)
            .LineSpacingRule = wdLineSpaceSingle
            .SpaceAfter = 3
        End With
    End If
End Function

' 刷新所有目录
Function UpdateAllTOC()
    Dim toc As TableOfContents
    Dim table As TableOfFigures
    
    ' 刷新正文目录
    For Each toc In ActiveDocument.TablesOfContents
        toc.Update
    Next toc
    
    ' 刷新图表目录
    For Each table In ActiveDocument.TablesOfFigures
        table.Update
    Next table
End Function



Sub H调整文档中标题等级()
    Dim para As Paragraph
    Dim currentStyle As style
    Dim highestLevel As Integer
    Dim levelOffset As Integer
    Dim i As Integer
    
    ' 初始化最高级别为最大值
    highestLevel = 9
    
    ' 第一步：扫描文档，找出最低的标题级别（数字最小的）
    For Each para In ActiveDocument.Paragraphs
        If para.style Like "标题 *" Then
            ' 提取标题级别数字
            i = Val(Right(para.style, 1))
            If i < highestLevel Then
                highestLevel = i
            End If
        End If
    Next para
    
    ' 如果没有找到任何标题，退出宏
    If highestLevel = 9 Then
        MsgBox "文档中没有找到标题样式。"
        Exit Sub
    End If
    
    ' 第二步：如果最高级别已经是1，无需调整
    If highestLevel = 1 Then
        MsgBox "文档中已包含级别1标题，无需调整。"
        Exit Sub
    End If
    
    ' 计算需要升级的级数
    levelOffset = highestLevel - 1
    
    ' 第三步：遍历所有段落，调整标题级别
    For Each para In ActiveDocument.Paragraphs
        If para.style Like "标题 *" Then
            ' 保存原始对齐方式
            originalAlignment = para.Range.ParagraphFormat.Alignment
            
            ' 提取当前标题级别
            i = Val(Right(para.style, 1))
            
            ' 计算新的标题级别
            Dim newLevel As Integer
            newLevel = i - levelOffset
            
            ' 确保新级别在有效范围内（1-9）
            If newLevel >= 1 And newLevel <= 9 Then
                ' 应用新的标题样式
                para.style = "标题 " & newLevel
            ElseIf newLevel < 1 Then
                ' 如果计算出的级别小于1，强制设为1
                para.style = "标题 1"
            End If
            
            ' 恢复原始对齐方式
            para.Range.ParagraphFormat.Alignment = originalAlignment
            
        End If
    Next para
    
    MsgBox "标题级别调整完成！原最高级别" & highestLevel & "已调整为级别1。"
End Sub



Sub D清除现有列表样式_非标准编号()
    Dim para As Paragraph
    Dim rng As Range
    Dim counter As Integer
    Dim originalText As String
    Dim newText As String
    
    counter = 0
    Application.ScreenUpdating = False
    
    For Each para In ActiveDocument.Paragraphs
        If para.style Like "标题 *" Then
            Set rng = para.Range
            originalText = rng.text
            
            ' 去除段落结束标记（通常是回车符）
            originalText = Left(originalText, Len(originalText) - 1)
            
            ' 检查是否有编号模式
            If HasNumberPattern(originalText) Then
                newText = RemoveNumberPatterns(originalText)
                
                ' 只有当文本确实发生变化时才更新
                If newText <> originalText Then
                    ' 重要：只替换文本内容，保持段落结构完整
                    rng.MoveEnd wdCharacter, -1 ' 排除段落标记
                    rng.text = newText
                    counter = counter + 1
                    
                    ' 重新应用标题样式
                    Dim level As Integer
                    level = GetHeadingLevel(para.style)
                    If level > 0 Then
                        rng.style = "标题 " & level
                    End If
                End If
            End If
            
            ' 清除列表格式（安全操作）
            On Error Resume Next
            para.Range.ListFormat.RemoveNumbers
            On Error GoTo 0
        End If
    Next para
    
    Application.ScreenUpdating = True
    MsgBox "已快速清理 " & counter & " 个标题的非标准编号。"
End Sub


Function RemoveNumberPatterns(text As String) As String
    Dim result As String
    result = text
    
    ' 去除各种常见的编号模式
    ' 1. 数字+点+空格 (如 "1. ", "1.1. ", "1.1.1. ")
    ' 2. 数字+空格 (如 "1 ", "1.1 "，"1.1.1 ")
    result = RegExReplace(result, "^\d+\.\d+\.\d+\.\d+\.\d+\.\s?", "")
    result = RegExReplace(result, "^\d+\.\d+\.\d+\.\d+\.\d+\s?", "")
    
    result = RegExReplace(result, "^\d+\.\d+\.\d+\.\d+\.\s?", "")
    result = RegExReplace(result, "^\d+\.\d+\.\d+\.\d+\s?", "")
    
    result = RegExReplace(result, "^\d+\.\d+\.\d+\.\s?", "")
    result = RegExReplace(result, "^\d+\.\d+\.\d+\s?", "")
    
    result = RegExReplace(result, "^\d+\.\d+\.\s?", "")
    result = RegExReplace(result, "^\d+\.\d+\s?", "")
    
    result = RegExReplace(result, "^\d+\.\s?", "")
    result = RegExReplace(result, "^\d+\s?", "")
    
    ' 3. 中文数字+顿号 (如 "一、", "二、")
    result = RegExReplace(result, "^[一二三四五六七八九十]、", "")
    
    ' 4. 字母+点+空格 (如 "A. ", "a. ")
    result = RegExReplace(result, "^[A-Za-z]\.\s?", "")
    
    ' 5. 罗马数字+点+空格 (如 "I. ", "II. ")
    result = RegExReplace(result, "^[IVXLCDM]+\.\s?", "")
    
    ' 6. 带括号的数字 (如 "(1)", "(1.1)")
    result = RegExReplace(result, "^\(\d+\)\s?", "")
    result = RegExReplace(result, "^\(\d+\.\d+\)\s?", "")
    
    ' 7. 去除开头空格
    result = Trim(result)
    
    RemoveNumberPatterns = result
End Function


' 正则表达式替换函数
Function RegExReplace(text As String, pattern As String, replacement As String) As String
    Dim regEx As Object
    Set regEx = CreateObject("VBScript.RegExp")
    
    With regEx
        .Global = True
        .IgnoreCase = True
        .MultiLine = False
        .pattern = pattern
    End With
    
    If regEx.Test(text) Then
        RegExReplace = regEx.Replace(text, replacement)
    Else
        RegExReplace = text
    End If
End Function


Function HasNumberPattern(text As String) As Boolean
    ' 检测文本是否包含常见的编号模式
    Dim patterns(10) As String
    Dim i As Integer
    
    patterns(0) = "^\d+\."              ' 数字+点
    patterns(1) = "^\d+"                ' 数字
    patterns(2) = "^[一二三四五六七八九十]、" ' 中文数字
    patterns(3) = "^[A-Za-z]\."         ' 字母+点
    patterns(4) = "^[IVXLCDM]+\."       ' 罗马数字
    patterns(5) = "^\(\d+\)"            ' 括号数字
    
    For i = 0 To 5
        If RegExTest(text, patterns(i)) Then
            HasNumberPattern = True
            Exit Function
        End If
    Next i
    
    HasNumberPattern = False
End Function

Function RegExTest(text As String, pattern As String) As Boolean
    Dim regEx As Object
    Set regEx = CreateObject("VBScript.RegExp")
    
    With regEx
        .Global = False
        .IgnoreCase = True
        .pattern = pattern
    End With
    
    RegExTest = regEx.Test(text)
End Function

Function GetHeadingLevel(styleName As String) As Integer
    If styleName Like "标题 *" Then
        GetHeadingLevel = Val(Right(styleName, 1))
    Else
        GetHeadingLevel = 0
    End If
End Function