使用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中更改樣式

回答

相關問題