在 Word 中更改样式

Question

我对编程很陌生，所以请原谅我的无知。

我正在尝试在没有任何标题样式或指定了不同标题样式的文档中创建特定标题。标题中正文之前的是数字。这些数字是特定的，本质上代表标题下方 material 的内容，因此不会改变。我正在寻找一种运行宏的方法，该宏将重新格式化数字标题及其旁边的文本。这将有助于浏览文档。当我输入代码时，没有出现任何错误，但标题仅使用 "Heading 2" 样式进行格式化，即使使用了多种标题样式也是如此。非常感谢这方面的任何帮助。代码如下：

Sub QOS_Headings()_

'
' QOS_Headings Macro

' Converts section headings in eCTD to usable navigation headings in Word.

'
Selection.Find.Text = ("3.2")_

Selection.Style = ActiveDocument.Styles("Heading 1")
Selection.Find.Text = ("3.2.S")
Selection.Style = ActiveDocument.Styles("Heading 2")
Selection.Find.Text = ("3.2.S.1")
Selection.Style = ActiveDocument.Styles("Heading 3")
Selection.Find.Text = ("3.2.S.2")
Selection.Style = ActiveDocument.Styles("Heading 3")
Selection.Find.Text = ("3.2.S.3")
Selection.Style = ActiveDocument.Styles("Heading 3")
Selection.Find.Text = ("3.2.S.4")
Selection.Style = ActiveDocument.Styles("Heading 3")
Selection.Find.Text = ("3.2.S.4.1")
Selection.Style = ActiveDocument.Styles("Heading 4")
Selection.Find.Text = ("3.2.S.4.2")
Selection.Style = ActiveDocument.Styles("Heading 4")
Selection.Find.Text = ("3.2.S.4.3")
Selection.Style = ActiveDocument.Styles("Heading 4")
Selection.Find.Text = ("3.2.S.4.4")
Selection.Style = ActiveDocument.Styles("Heading 4")
Selection.Find.Text = ("3.2.S.4.5")
Selection.Style = ActiveDocument.Styles("Heading 4")
Selection.Find.Text = ("3.2.S.6")
Selection.Style = ActiveDocument.Styles("Heading 3")
Selection.Find.Text = ("3.2.S.7")
Selection.Style = ActiveDocument.Styles("Heading 3")
Selection.Find.Text = ("3.2.P")
Selection.Style = ActiveDocument.Styles("Heading 2")
Selection.Find.Text = ("3.2.P.1")
Selection.Style = ActiveDocument.Styles("Heading 3")
Selection.Find.Text = ("3.2.P.2")
Selection.Style = ActiveDocument.Styles("Heading 3")
Selection.Find.Text = ("3.2.P.3")
Selection.Style = ActiveDocument.Styles("Heading 3")
Selection.Find.Text = ("3.2.P.4")
Selection.Style = ActiveDocument.Styles("Heading 3")
Selection.Find.Text = ("3.2.P.5")
Selection.Style = ActiveDocument.Styles("Heading 3")
Selection.Find.Text = ("3.2.P.5.1")
Selection.Style = ActiveDocument.Styles("Heading 4")
Selection.Find.Text = ("3.2.P.5.2")
Selection.Style = ActiveDocument.Styles("Heading 4")
Selection.Find.Text = ("3.2.P.5.3")
Selection.Style = ActiveDocument.Styles("Heading 4")
Selection.Find.Text = ("3.2.P.5.4")
Selection.Style = ActiveDocument.Styles("Heading 4")
Selection.Find.Text = ("3.2.P.5.5")
Selection.Style = ActiveDocument.Styles("Heading 4")
Selection.Find.Text = ("3.2.P.5.6")
Selection.Style = ActiveDocument.Styles("Heading 4")
Selection.Find.Text = ("3.2.P.6")
Selection.Style = ActiveDocument.Styles("Heading 3")
Selection.Find.Text = ("3.2.P.7")
Selection.Style = ActiveDocument.Styles("Heading 3")
Selection.Find.Text = ("3.2.P.8")
Selection.Style = ActiveDocument.Styles("Heading 3")
Selection.Find.Text = ("3.2.A")
Selection.Style = ActiveDocument.Styles("Heading 2")
Selection.Find.Text = ("3.2.A.1")
Selection.Style = ActiveDocument.Styles("Heading 3")
Selection.Find.Text = ("3.2.A.2")
Selection.Style = ActiveDocument.Styles("Heading 3")
Selection.Find.Text = ("3.2.A.3")
Selection.Style = ActiveDocument.Styles("Heading 3")
Selection.Find.Text = ("3.2.R")
Selection.Style = ActiveDocument.Styles("Heading 2")
End Sub

Answer 1

因此，有几种方法可以使您的代码更具可扩展性或可重用性。您可以使用通配符搜索来最小化所需的实际搜索次数。或者，您可以将文本字符串放入循环遍历的数组中，以将实际代码保持在最低限度。为了您的目的，并尽可能清楚地说明这一点，我没有这样做。这只是接受您的搜索并使它们成为实际的搜索和替换，以便仅在找到文本时才进行更改。为了将您的搜索限制在单独一行的文本中，我添加了特殊的“^p”查找序列。这将搜索您的文本，然后是段落分隔符。这并不完美，但它应该更接近你正在寻找的东西。如果您在运行之后仍然只看到应用了标题 2，则可能有必要在您的问题中包含文档的一部分文本，以准确说明它的外观。

Sub QOS_Headings()
Dim objDoc As Document
Dim head1 As Style, head2 As Style, head3 As Style, head4 As Style
'
' QOS_Headings Macro

' Converts section headings in eCTD to usable navigation headings in Word.

'

' Using variables here just simplifies the typing further on, and allows
' you to easily change, for instance, "Heading 4" to "My Personal Heading 4"
' if you were creating your own styles.

Set objDoc = ActiveDocument
' This code does *NOT* protect against the possibility that these styles don't
' appear in the document. That's probably not a concern with built-in styles,
' but be aware of that if you want to expand upon this for other uses.
Set head1 = ActiveDocument.Styles("Heading 1")
Set head2 = ActiveDocument.Styles("Heading 2")
Set head3 = ActiveDocument.Styles("Heading 3")
Set head4 = ActiveDocument.Styles("Heading 4")

' This searches the entire document (not including foot/endnotes, headers, or footers)
' for your text string. Putting "^p" at the end of the string limits it to text strings
' that fall at the end of a paragraph, which is likely the case as your headings sit on
' their own line. You might want to experiment with that. Note that putting ^p at the
' beginning of the text will NOT work; that will apply your style to the previous
' paragraph as well.
With objDoc.Content.Find
    .ClearFormatting
    .Text = "3.2^p"
    With .Replacement
    .ClearFormatting
    .Style = head1
    End With
    ' Here we do the actual replacement. Based on your requirements, this only replaces the
    ' first instance it finds. You could also change this to Replace:=wdReplaceAll to catch
    ' all of them.
    .Execute Wrap:=wdFindContinue, Format:=True, Replace:=wdReplaceOne
End With

With objDoc.Content.Find
    .ClearFormatting
    .Text = "3.2.S^p"
    With .Replacement
    .ClearFormatting
    .Style = head2
    End With
    .Execute Wrap:=wdFindContinue, Format:=True, Replace:=wdReplaceOne
End With
With objDoc.Content.Find
    .ClearFormatting
    .Text = "3.2.S.1^p"
    With .Replacement
    .ClearFormatting
    .Style = head3
    End With
    .Execute Wrap:=wdFindContinue, Format:=True, Replace:=wdReplaceOne
End With
With objDoc.Content.Find
    .ClearFormatting
    .Text = "3.2.S.2^p"
    With .Replacement
    .ClearFormatting
    .Style = head3
    End With
    .Execute Wrap:=wdFindContinue, Format:=True, Replace:=wdReplaceOne
End With
With objDoc.Content.Find
    .ClearFormatting
    .Text = "3.2.S.3^p"
    With .Replacement
    .ClearFormatting
    .Style = head3
    End With
    .Execute Wrap:=wdFindContinue, Format:=True, Replace:=wdReplaceOne
End With
With objDoc.Content.Find
    .ClearFormatting
    .Text = "3.2.S.4^p"
    With .Replacement
    .ClearFormatting
    .Style = head3
    End With
    .Execute Wrap:=wdFindContinue, Format:=True, Replace:=wdReplaceOne
End With
With objDoc.Content.Find
    .ClearFormatting
    .Text = "3.2.S.4.1^p"
    With .Replacement
    .ClearFormatting
    .Style = head4
    End With
    .Execute Wrap:=wdFindContinue, Format:=True, Replace:=wdReplaceOne
End With
With objDoc.Content.Find
    .ClearFormatting
    .Text = "3.2.S.4.2^p"
    With .Replacement
    .ClearFormatting
    .Style = head4
    End With
    .Execute Wrap:=wdFindContinue, Format:=True, Replace:=wdReplaceOne
End With
With objDoc.Content.Find
    .ClearFormatting
    .Text = "3.2.S.4.3^p"
    With .Replacement
    .ClearFormatting
    .Style = head4
    End With
    .Execute Wrap:=wdFindContinue, Format:=True, Replace:=wdReplaceOne
End With
With objDoc.Content.Find
    .ClearFormatting
    .Text = "3.2.S.4.4^p"
    With .Replacement
    .ClearFormatting
    .Style = head4
    End With
    .Execute Wrap:=wdFindContinue, Format:=True, Replace:=wdReplaceOne
End With
With objDoc.Content.Find
    .ClearFormatting
    .Text = "3.2.S.4.5^p"
    With .Replacement
    .ClearFormatting
    .Style = head4
    End With
    .Execute Wrap:=wdFindContinue, Format:=True, Replace:=wdReplaceOne
End With
With objDoc.Content.Find
    .ClearFormatting
    .Text = "3.2.S.6^p"
    With .Replacement
    .ClearFormatting
    .Style = head3
    End With
    .Execute Wrap:=wdFindContinue, Format:=True, Replace:=wdReplaceOne
End With
With objDoc.Content.Find
    .ClearFormatting
    .Text = "3.2.S.7^p"
    With .Replacement
    .ClearFormatting
    .Style = head3
    End With
    .Execute Wrap:=wdFindContinue, Format:=True, Replace:=wdReplaceOne
End With
With objDoc.Content.Find
    .ClearFormatting
    .Text = "3.2.P^p"
    With .Replacement
    .ClearFormatting
    .Style = head2
    End With
    .Execute Wrap:=wdFindContinue, Format:=True, Replace:=wdReplaceOne
End With
With objDoc.Content.Find
    .ClearFormatting
    .Text = "3.2.P.1^p"
    With .Replacement
    .ClearFormatting
    .Style = head3
    End With
    .Execute Wrap:=wdFindContinue, Format:=True, Replace:=wdReplaceOne
End With
With objDoc.Content.Find
    .ClearFormatting
    .Text = "3.2.P.2^p"
    With .Replacement
    .ClearFormatting
    .Style = head3
    End With
    .Execute Wrap:=wdFindContinue, Format:=True, Replace:=wdReplaceOne
End With
With objDoc.Content.Find
    .ClearFormatting
    .Text = "3.2.P.3^p"
    With .Replacement
    .ClearFormatting
    .Style = head3
    End With
    .Execute Wrap:=wdFindContinue, Format:=True, Replace:=wdReplaceOne
End With
With objDoc.Content.Find
    .ClearFormatting
    .Text = "3.2.P.4^p"
    With .Replacement
    .ClearFormatting
    .Style = head3
    End With
    .Execute Wrap:=wdFindContinue, Format:=True, Replace:=wdReplaceOne
End With
With objDoc.Content.Find
    .ClearFormatting
    .Text = "3.2.P.5^p"
    With .Replacement
    .ClearFormatting
    .Style = head3
    End With
    .Execute Wrap:=wdFindContinue, Format:=True, Replace:=wdReplaceOne
End With
With objDoc.Content.Find
    .ClearFormatting
    .Text = "3.2.P.5.1^p"
    With .Replacement
    .ClearFormatting
    .Style = head4
    End With
    .Execute Wrap:=wdFindContinue, Format:=True, Replace:=wdReplaceOne
End With
With objDoc.Content.Find
    .ClearFormatting
    .Text = "3.2.P.5.2^p"
    With .Replacement
    .ClearFormatting
    .Style = head4
    End With
    .Execute Wrap:=wdFindContinue, Format:=True, Replace:=wdReplaceOne
End With
With objDoc.Content.Find
    .ClearFormatting
    .Text = "3.2.P.5.3^p"
    With .Replacement
    .ClearFormatting
    .Style = head4
    End With
    .Execute Wrap:=wdFindContinue, Format:=True, Replace:=wdReplaceOne
End With
With objDoc.Content.Find
    .ClearFormatting
    .Text = "3.2.P.5.4^p"
    With .Replacement
    .ClearFormatting
    .Style = head4
    End With
    .Execute Wrap:=wdFindContinue, Format:=True, Replace:=wdReplaceOne
End With
With objDoc.Content.Find
    .ClearFormatting
    .Text = "3.2.P.5.5^p"
    With .Replacement
    .ClearFormatting
    .Style = head4
    End With
    .Execute Wrap:=wdFindContinue, Format:=True, Replace:=wdReplaceOne
End With
With objDoc.Content.Find
    .ClearFormatting
    .Text = "3.2.P.5.6^p"
    With .Replacement
    .ClearFormatting
    .Style = head4
    End With
    .Execute Wrap:=wdFindContinue, Format:=True, Replace:=wdReplaceOne
End With
With objDoc.Content.Find
    .ClearFormatting
    .Text = "3.2.P.6^p"
    With .Replacement
    .ClearFormatting
    .Style = head3
    End With
    .Execute Wrap:=wdFindContinue, Format:=True, Replace:=wdReplaceOne
End With
With objDoc.Content.Find
    .ClearFormatting
    .Text = "3.2.P.7^p"
    With .Replacement
    .ClearFormatting
    .Style = head3
    End With
    .Execute Wrap:=wdFindContinue, Format:=True, Replace:=wdReplaceOne
End With
With objDoc.Content.Find
    .ClearFormatting
    .Text = "3.2.P.8^p"
    With .Replacement
    .ClearFormatting
    .Style = head3
    End With
    .Execute Wrap:=wdFindContinue, Format:=True, Replace:=wdReplaceOne
End With
With objDoc.Content.Find
    .ClearFormatting
    .Text = "3.2.A^p"
    With .Replacement
    .ClearFormatting
    .Style = head2
    End With
    .Execute Wrap:=wdFindContinue, Format:=True, Replace:=wdReplaceOne
End With
With objDoc.Content.Find
    .ClearFormatting
    .Text = "3.2.A.1^p"
    With .Replacement
    .ClearFormatting
    .Style = head3
    End With
    .Execute Wrap:=wdFindContinue, Format:=True, Replace:=wdReplaceOne
End With
With objDoc.Content.Find
    .ClearFormatting
    .Text = "3.2.A.2^p"
    With .Replacement
    .ClearFormatting
    .Style = head3
    End With
    .Execute Wrap:=wdFindContinue, Format:=True, Replace:=wdReplaceOne
End With
With objDoc.Content.Find
    .ClearFormatting
    .Text = "3.2.A.3^p"
    With .Replacement
    .ClearFormatting
    .Style = head3
    End With
    .Execute Wrap:=wdFindContinue, Format:=True, Replace:=wdReplaceOne
End With
With objDoc.Content.Find
    .ClearFormatting
    .Text = "3.2.R^p"
    With .Replacement
    .ClearFormatting
    .Style = head2
    End With
    .Execute Wrap:=wdFindContinue, Format:=True, Replace:=wdReplaceOne
End With
End Sub

最后一个建议：开始 VBA 编程的一种方法是使用宏记录器。它并不完美，但它会给你基本的结构，例如，如果你记录自己做的搜索和替换。

在 Word 中更改样式

Changing styles in Word

vba

ms-word

styles