Word VBA: Установить абзац перед жирным текстом с помощью макроса

[Anton]

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

Пример приложил.



[вложение удалено администратором]

[Администратор]

Работа со всем файлом:

Макрос

Sub макрос()

    Dim par As Paragraph, i As Long
   
   
    ' Отключение монитора для ускорения макроса.
    Application.ScreenUpdating = False
   
    '1. Цикл по всем абзацам в основной части файла.
        ' Цикл от последнего абзаца к первому, т.к. будут вставляться абзацы и
        ' порядковая нумерация абзацев будет изменяться.
    For i = ActiveDocument.Paragraphs.Count To 2 Step -1
        ' Присваиваем абзацу имя "par", чтобы было удобнее читать и писать код.
        Set par = ActiveDocument.Paragraphs(i)
        ' Смотрим, есть ли жирность у первого символа в абзаце.
        If par.Range.Characters(1).Font.Bold = True Then
            ' Смотрим, нет ли спереди пустого абзаца.
            If par.Previous.Range.Characters.Count > 1 Then
                ' Вставка перед абзацем пустого абзаца.
                par.Range.InsertBefore Chr(13)
                ' Убирание жирности у пустого абзаца для удобства юзера.
                par.Previous.Range.Font.Bold = False
            End If
        End If
    Next i
   
    '2. Сообщение.
    Application.ScreenUpdating = True
    MsgBox "Готово!", vbInformation

End Sub

[свернуть]

Работа с выделенным фрагментом:

Макрос

Sub макрос()

    Dim par As Paragraph, start_ As Long, i As Long
   
   
    ' Отключение монитора для ускорения макроса.
    Application.ScreenUpdating = False
   
    '1. Определяем, до какого абзаца двигаться. Если первый абзац в выделенном
        ' фрагменте это первый абзац в файле, то будет ошибка при обращении
        ' к вышестоящему абзацу.
    If Selection.Paragraphs(1).Range.Start = ActiveDocument.Paragraphs(1).Range.Start Then
        start_ = 2
    Else
        start_ = 1
    End If
   
    '2. Цикл по всем абзацам в выделенном фрагменте.
        ' Цикл от последнего абзаца к первому, т.к. будут вставляться абзацы и
        ' порядковая нумерация абзацев будет изменяться.
    For i = Selection.Paragraphs.Count To start_ Step -1
        ' Присваиваем абзацу имя "par", чтобы было удобнее читать и писать код.
        Set par = Selection.Paragraphs(i)
        ' Смотрим, есть ли жирность у первого символа в абзаце.
        If par.Range.Characters(1).Font.Bold = True Then
            ' Смотрим, нет ли спереди пустого абзаца.
            If par.Previous.Range.Characters.Count > 1 Then
                ' Вставка перед абзацем пустого абзаца.
                par.Range.InsertBefore Chr(13)
                ' Убирание жирности у пустого абзаца для удобства юзера.
                par.Previous.Range.Font.Bold = False
            End If
        End If
    Next i
   
    '3. Сообщение.
    Application.ScreenUpdating = True
    MsgBox "Готово!", vbInformation

End Sub

[свернуть]

[Anton]

Получилось как надо!
Большое спасибо!