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