Vba 在Word中更改样式

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

我试图在一个文档中创建特定的标题，但该文档没有指定任何标题样式或指定了不同的标题样式。标题中文本的前面是数字。数字是具体的，基本上代表标题下材料的内容，因此不会改变。我正在寻找一种方法来运行一个宏，它将重新格式化数字标题及其旁边的文本。这将有助于浏览文档。当我输入代码时，我没有收到任何错误，但是标题的格式仅为“标题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

---

因此，有几种方法可以使代码更具可扩展性或可重用性。您可以使用通配符搜索来最小化所需的实际搜索数。或者，您可以将文本字符串放入一个数组中，循环使用该数组，以将实际代码保持在最小值。为了你的目的，为了尽可能清楚地说明这一点，我没有这样做。这只是将您的搜索进行实际搜索和替换，以便仅在找到文本时进行更改。为了将您的搜索限制为文本行，我添加了特殊的“^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编程的一种方法是使用宏记录器。它并不完美，但它会为您提供基本的结构，例如，如果您记录自己进行搜索和替换，它会为您提供基本的结构。

您确定文档中确实存在所有这些文本字符串吗？你不会在应用样式之前检查它们是否被找到。嗨，克里斯蒂娜。谢谢你的回复。如果你的意思是那些3.2*的数字存在于文档中，那么是的。正如我所说，我对这个编程非常陌生。从本质上说，我试图找出这些文档中始终存在的数字，然后将它们格式化为分层标题样式，将文本单独保留在部分中。我是否必须告诉程序选择要搜索的整个文档？你能提供的任何信息都会有帮助。每个数字是否只出现一次，它们是否出现在各自的行中？是的，每个数字只出现一次，并且出现在各自的行中。但是，文档正文中可能会有数字单独显示为3.2。为了回避这个问题，我可以在相关部分添加口头标题。例如，“3.2方法”。这些标题也不会因文件而异。每个标题下的内容可能完全不同，长度也可能不同。感谢克里斯蒂娜的帮助。我将很快尝试这个代码。我将发布运行它时发生的情况。这太棒了！我一直在使用宏记录器，暂停并运行它，然后在记录我正在做的事情时运行它。第一次的时候它变得很混乱，但我确实看到了这样做的价值。再次感谢你抽出时间。哇！太神了这很有魅力！这会很好！我会对循环方面感兴趣，但我可以稍后再了解。有一件事我必须确保，那就是确保文档中的数字后面没有空格。我在第一次运行脚本时发现了这一点。有些标题改变了，但大多数没有。一旦我解决了这个问题，脚本就完美地运行了。我对你感激不尽。通过您生成的代码，我已经学到了很多。谢谢你的课！我来这里是为了寻找秘方，将内置样式应用于Microsoft Outlook邮件中的选择。我发现，与我下一个问题的答案一起，以ClearFormatting方法的一种变体的形式出现。