Макрос VBA для форматирования всех заголовков в документе как жирный

Question

Я пытаюсь автоматизировать поиск / замену заголовков в документе Word 2013 (обратите внимание, что это не заголовки в стиле Word, а просто текст, набранный в верхнем регистре с двоеточием). Например:

ГЛАВНАЯ ЖАЛОБА:

ФИЗИЧЕСКАЯ ЭКСПЕРТИЗА:

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

Ручной поиск / замена: ^ 13 (*:)

К этому: ^ p \ 1

Работает, за исключением случаев, когда первый экземпляр находится в начале файла (без возврата).

Вот макрос, который я использовал:

Sub BoldHeadings()
'
' BoldHeadings Macro
'
Application.ScreenUpdating = False
With ActiveDocument.Range.Find
  .ClearFormatting
  .Replacement.ClearFormatting
  .Format = False
  .Forward = True
  .MatchWildcards = True
  .Wrap = wdFindContinue
  .Text = "^13(*:)"
  .Replacement.Text = "^p\1"
  .Replacement.Font.Bold = True
  .Execute Replace:=wdReplaceAll
  .Replacement.ClearFormatting
End With
Application.ScreenUpdating = True
End Sub

Как уже говорилось, это работает нормально, если только первый экземпляр не находится в начале файла. Есть ли другой способ, которым я могу достичь этого?

Спасибо!

Answer 1

Попробуйте:

Sub BoldHeadings()
Application.ScreenUpdating = False
With ActiveDocument.Range
  .InsertBefore vbCr
  With .Find
    .ClearFormatting
    .Replacement.ClearFormatting
    .Replacement.Font.Bold = True
    .Text = "^13*:"
    .Replacement.Text = "^&"
    .Format = True
    .Forward = True
    .MatchWildcards = True
    .Wrap = wdFindContinue
    .Execute Replace:=wdReplaceAll
  End With
  .Paragraphs.First.Range.Delete
End With
Application.ScreenUpdating = True
End Sub