使用vba在Word中更改样式

我对编程非常陌生，所以请原谅我的无知。使用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

来源

2015-04-29 DP7

你确定所有这些文本串中实际存在的文件？在应用样式之前，您没有检查它们是否被发现。 – Christina

嗨克里斯蒂娜。感谢您的回复。如果你的意思是这些3.2 *号码存在于他的文档中，那么他们确实是这样。正如我所说，我对这个编程的东西很陌生。）。从本质上讲，我试图挑选出总是在这些文档中的数字，然后将它们格式化为分层标题样式，而仅将这些文本留在部分内。我是否必须告诉程序选择要搜索的整个文档？您可以提供的任何信息都会有所帮助。 – DP7

每个数字是否只出现一次，并且它们是否出现在他们自己的行上？ – Christina

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

来源

2015-05-06 16:46:13 Christina

感谢您的帮助Christina。我会很快尝试这个代码。我会发布当我运行它时会发生什么。这很棒！我一直在使用宏记录器，暂停和运行它，只是运行它，因为我记录了我正在做的事情。第一次它变得相当混乱，但我确实看到了这样做的价值。再次感谢您的时间。 – DP7

哇！惊人。这工作就像一个魅力！这将很好地做！我会对循环方面感兴趣，但我可以稍后再学习。有一件事是我必须确定的，即确保文件中的号码后没有空格。之后当我第一次运行脚本时，我发现了这一点。一些标题改变了，但大多数没有改变。一旦我解决了这个问题，剧本就完美无瑕。我不知道该怎么感谢你才足够。用你生成的代码，我已经学到了很多东西。感谢您的教训！ – DP7

eCTD的快乐世界。

由于您的文章是在一年前，我假设您取得了进展，但如果您希望在单个文档中包含S，P，A和R部分，您也会发现需要多组标题样式。

实际上，它实际上要好得多以便更细化，以便您在QOS的S1，S2，P1，P2级别上有文档。

然后，您可以使用手动编号和非标题样式设置初始标题，例如标题。

然后，您可以设置内置标题的合法编号。

这意味着您有一套更简单的样式定义和适用于任何eCTD部分的方案。

例如

3.2.P.2药物开发（标题风格 - 数手动键入） 1.药物产品（法律编号标题1） 1.1药物物质（标题2法律编号） 1.2赋形剂的组件 2.药物产品 2.1配方开发 2.2超龄 2.3理化和生物学特性 3.制造过程开发 4.容器密闭系统 5.微生物特性 6。兼容性

问候

史蒂夫

来源

2016-11-29 09:22:01 freeflow

使用vba在Word中更改样式

回答

相关问题