我对编程很陌生，所以请原谅我的无知。
我正在尝试在没有任何标题或指定了不同标题样式的文档中创建特定标题。标题中文本前面的是数字。这些数字是具体的，基本上代表了标题下材料的内容，因此不会改变。我正在寻找一种运行宏的方法，该方法可以重新格式化数字标题及其旁边的文本。这将有助于在文档中导航。当我输入代码时，我没有出现任何错误，但标题的格式仅为"标题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编程的一种方法是使用宏记录器。它并不完美，但它会给你一个基本的结构，例如，如果你记录自己做了一个搜索和替换。