使用Word VBA,根据数字模式应用各种标题样式

时间:2015-04-06 20:11:36

标签: vba ms-word word-vba

我对VBA很新。我在各种作者的大型文档中用标题样式标记文本。是否有可能在粗体文本行上识别数字模式,并将适当的样式应用于整行(通常在行尾有一个硬回车)。

例如,我们的文档通常编号如下,我们会相应地标记文本。

1.0 text here     (apply Heading 1)
1.2 text here     (apply Heading 2)
1.2.1 text here   (apply Heading 3)
1.2.1.1 text here (apply Heading 4)

2.0 text here     (apply Heading 1)
2.2 text here     (apply Heading 2)
….and so on

我做了很多研究,但我不确定这是否可行。我们不使用任何类型的自动编号。

1 个答案:

答案 0 :(得分:0)

是的,这是可能的。试试这段代码:

Sub ApplyHeadings()
    Dim rg1 As Range
    Dim rg2 As Range
    Dim pos As Long
    Dim i As Long
    Dim dots As Long

    Set rg1 = ActiveDocument.Range
    With rg1.Find
        .MatchWildcards = True
        .Text = "[0-9.]{2,}[!^13]@[^13]"
        .Wrap = wdFindStop
        While .Execute
            Set rg2 = rg1.Duplicate
            dots = 0
            ' isolate the numbering
            pos = InStr(rg2.Text, " ")
            If pos > 0 Then rg2.End = rg2.Start + pos - 1
            For i = 1 To Len(rg2.Text)
                ' count the dots in the number
                If Mid(rg2.Text, i, 1) = "." Then dots = dots + 1
            Next i
            ' apply correct heading level
            Select Case dots
                Case 1
                    If Mid(rg2.Text, 3, 1) = "0" Then
                        rg1.Style = ActiveDocument.Styles("Heading 1")
                    Else
                        rg1.Style = ActiveDocument.Styles("Heading 2")
                    End If
                Case 2, 3  ' maybe more...
                    rg1.Style = ActiveDocument.Styles("Heading " & CStr(dots + 1))
                Case Else
                    ' do nothing
            End Select
            ' prepare for next find
            rg1.Collapse wdCollapseEnd
        Wend
    End With
End Sub