Word VBA Macro: заменить новые строки пунктами

Question

Мне нужно сделать следующее в макросе Word.

Мне нужно пройти документ Word и изменить некоторые параграфы на основе их параметров. Если размер шрифта абзаца равен 19,5, абзац должен получить стиль. Заголовок 1. Следующий абзац будет заголовком 2, а следующий после него - заголовком 3. В другом тексте останется стиль «Обычный».

Написал макрос:

Sub styles_temp() 

' Declare a paragraph 
Dim p As Paragraph 

' Declare the current size. 
Dim currentSize As Single 

'Iterate through the text and print each paragraph 
For Each p In ActiveDocument.Paragraphs 

' Determine current size of the paragraph 
currentSize = p.Range.Font.Size 

' If size is 19.5, it will be Heading 1 
If currentSize = 19.5 Then 

    p.Range.Style = ActiveDocument.Styles("Heading 1") 

    ' Next Line is Heading 2 
    p.Next.Range.Style = ActiveDocument.Styles("Heading 2") 


ElseIf p.Range.Style = "Heading 2" Then 
    p.Next.Range.Style = ActiveDocument.Styles("Heading 3") 

End If 

Next p 

End Sub 

Проблема заключается в том, что иногда текст содержит пункт, а иногда просто новая линия. Попытка выяснить, заменить ли все новые строки абзацами. Поблагодарили бы за любую помощь.

Спасибо!

Answer 1

Это звучит, как вы имеете в виду весь документ: «заменить все новые строки с пунктами»

ActiveDocument.Content.Find.Execute FindTExt:="^l", ReplaceWith:="^p", Replace:=wdReplaceAll 

Примечание: Ваш код использует ActiveDocument много. Было бы более эффективным и безопасным присвоить это переменной:

Dim doc as Word.Document 
Set doc = ActiveDocument 
doc.Content.Find.Execute FindTExt:="^l", ReplaceWith:="^p", Replace:=wdReplaceAll