用于更改标题样式的Microsoft Word宏

时间:2017-06-09 14:31:13

标签: vba word-vba

我试图在Word中创建一个宏来改变一组约150个独特标题的样式。所有款式必须相同。我当前的代码正常工作并正确更改格式,但一次只能更改一个标题。 简单地说,它很难看。

我正在寻找可以重复使用的东西,并且可能在将来适用于更多项目。

也许使用loop命令?我不知道,我使用VBA还是有点新鲜。

Sub QOS_Headings()
Dim objDoc As Document
Dim head1 As Style, head2 As Style, head3 As Style, head4 As Style
    Set objDoc = ActiveDocument
    Set head1 = ActiveDocument.Styles("Heading 1")
    Set head2 = ActiveDocument.Styles("Heading 2")

With objDoc.Content.Find
    .ClearFormatting
    .Text = "Section A.^p"
    With .Replacement
    .ClearFormatting
    .Style = head1
    End With
    .Execute Wrap:=wdFindContinue, Format:=True, Replace:=wdReplaceOne
End With
End With
End Sub

1 个答案:

答案 0 :(得分:0)

如果您无法自动识别所需的头部,则可能需要编写一次所有内容。为此目的创建单独的功能。它可能看起来像这样: -

Private Function SearchCriteria() As String()

    Dim Fun(6) As String                 ' Fun = Designated Function return value

    ' The number of elements in the Dim statement must be equal to
    ' the number of elements actually declared:
      ' observe that the actual number of elements is one greater
      ' than the index because the latter starts at 0
    Fun(0) = "Text 1"
    Fun(1) = "Text 2"
    Fun(2) = "Text 3"
    Fun(3) = "Text 4"
    Fun(4) = "Text 5"
    Fun(5) = "Text 6"
    Fun(6) = "Text 7"

    SearchCriteria = Fun
End Function

您可以根据需要添加任意数量的元素。理论上,如果它们在文档中是唯一的就足够了。我将在下面添加一些实际问题。使用下面的代码测试上述功能。

Private Sub TestSearchCriteria()

    Dim Crits() As String
    Dim i As Long

    Crits = SearchCriteria
    For i = 0 To UBound(Crits)
        ' prints to the Immediate Window:
        ' select from View tab or press Ctl+G
        Debug.Print Crits(i)
    Next i
End Sub

现在您已准备好尝试实际处理您的文档。这是代码。它不会影响任何变化。它只是测试和准备的基础设施。

Sub ChangeTextFormat()

    Dim Crits() As String
    Dim Rng As Range
    Dim Fnd As Boolean
    Dim i As Long

    Crits = SearchCriteria
    For i = 0 To UBound(Crits)
        ' find the Text in the document
        Set Rng = ActiveDocument.Content
        With Rng.Find
            .ClearFormatting
            .Execute FindText:=Crits(i), Forward:=True, _
                     Format:=False, Wrap:=wdFindStop
            Fnd = .Found
        End With

        If Fnd = True Then
            With Rng
                Debug.Print .Text
'                .MoveStart wdWord, -2
'                With .Font
'                    .Italic = True
'                    .Bold = True
'                End With
            End With
        Else
            Debug.Print "Didn't find " & Crits(i)
        End If
    Next i
End Sub

该过程的前半部分将使用您在测试过程中已知的相同类型的循环来查找文档中的每个搜索条件。但现在文本被输入Find方法,该方法将找到的文本分配到Rng范围。如果找到该项目,您现在可以使用Rng的名称来处理它。

该子的后半部分涉及搜索的结果。如果找到文本,则找到的文本(即Rng.Text)将打印到立即窗口,否则原始文本Crits(i)将显示“未找到”。

如果找到文本,则要为其指定样式。但在此之前,您应该处理找到的文本与要格式化的文本之间的区别。这种差异可能是物理的,就像你没有在标准中写出文本的整个长度,或者是技术性的,比如排除段落标记。在我的上面的子中只有随机代码(将Rng扩展为前两个单词,并将所有内容格式化为粗体斜体)。将此代码视为占位符。

为了您的目的,这样的代码可能会完成这项工作。 .Paragraphs(1).Style = Head1实际上,这是一个不同的问题,我强烈建议你不要急于求得这个结果。您现在拥有的部分需要先进行全面测试。