---

Sub ApplySettings()
    If Selection.Type = 1 Then Exit Sub
    
    ' Переходим в режим разметки и принудительно обновляем страницы
    ActiveWindow.View.Type = 3 ' wdPrintView
    ActiveDocument.Repaginate
    
    Dim selRange As Range
    Set selRange = Selection.Range
    
    ' 1. ОБЩЕЕ ОФОРМЛЕНИЕ
    With selRange
        .Font.Name = "Times New Roman"
        .Font.Size = 14
        .Font.Italic = False
        With .ParagraphFormat
            .Alignment = 3
            .FirstLineIndent = CentimetersToPoints(1.25)
            .SpaceBefore = 0: .SpaceBeforeAuto = False
            .SpaceAfter = 0: .SpaceAfterAuto = False
            .LineSpacingRule = 0
        End With
    End With

    ' 2. ЗАМЕНЫ (Тире и Кавычки)
    Call GlobalReplace(selRange, "—", "–", False)
    Call GlobalReplace(selRange, """([!""^13]@)""", "«\1»", True)
    
    ' 3. АНГЛИЙСКИЙ КУРСИВ (улучшенный поиск)
    Dim engRange As Range
    Set engRange = Selection.Range
    With engRange.Find
        .ClearFormatting
        .Text = "[a-zA-Z]{1;}" ' Ищем латиницу
        .Replacement.Font.Italic = True
        .Replacement.Text = "^&"
        .MatchWildcards = True
        .Forward = True
        .Wrap = wdFindStop
        .Execute Replace:=2
    End With

    ' 4. ОБРАБОТКА КАРТИНОК И УМНАЯ РАССТАНОВКА ENTER
    Dim i As Long
    Dim iShape As InlineShape
    Dim picPara As Paragraph, currPara As Paragraph
    
    For i = selRange.InlineShapes.Count To 1 Step -1
        Set iShape = selRange.InlineShapes(i)
        Set picPara = iShape.Range.Paragraphs(1)
        
        ' 4.1 Картинка по центру
        picPara.Range.ParagraphFormat.Alignment = 1
        picPara.Range.ParagraphFormat.FirstLineIndent = 0
        
        ' 4.2 Очистка ПЕРЕД картинкой и вставка Enter
        Set currPara = picPara.Previous
        Do While Not currPara Is Nothing
            If IsEmptyPara(currPara) Then
                currPara.Range.Delete
                Set currPara = picPara.Previous
            Else
                Exit Do
            End If
        Loop
        If Not currPara Is Nothing Then
            ActiveDocument.Repaginate ' Обновляем перед проверкой
            If picPara.Range.Information(3) = currPara.Range.Information(3) Then
                picPara.Range.InsertParagraphBefore
            End If
        End If
        
        ' 4.3 Очистка МЕЖДУ картинкой и подписью
        Set currPara = picPara.Next
        Do While Not currPara Is Nothing
            If IsEmptyPara(currPara) Then
                currPara.Range.Delete
                Set currPara = picPara.Next
            Else
                Exit Do
            End If
        Loop
        
        ' 4.4 Оформление подписи
        If Not currPara Is Nothing Then
            With currPara.Range
                .Font.Size = 12
                .ParagraphFormat.Alignment = 1
                .ParagraphFormat.FirstLineIndent = 0
            End With
            
            ' 4.5 Умный Enter ПОСЛЕ подписи
            Dim captionPara As Paragraph
            Set captionPara = currPara
            
            Set currPara = captionPara.Next
            Do While Not currPara Is Nothing
                If IsEmptyPara(currPara) Then
                    currPara.Range.Delete
                    Set currPara = captionPara.Next
                Else
                    Exit Do
                End If
            Loop
            
            ' ПРОВЕРКА: Нужен ли Enter после подписи
            If Not currPara Is Nothing Then
                ActiveDocument.Repaginate ' Принудительный пересчет страниц
                
                Dim p1 As Integer, p2 As Integer
                p1 = captionPara.Range.Information(3) ' Страница подписи
                p2 = currPara.Range.Characters(1).Information(3) ' Страница начала текста
                
                ' Если текст на той же странице — ставим Enter
                If p1 = p2 Then
                    captionPara.Range.InsertParagraphAfter
                End If
            End If
        End If
    Next i
End Sub

' Функция проверки пустого абзаца
Function IsEmptyPara(p As Paragraph) As Boolean
    Dim t As String
    t = p.Range.Text
    t = Replace(t, vbCr, "")
    t = Replace(t, " ", "")
    t = Replace(t, vbTab, "")
    t = Replace(t, Chr(12), "") ' Разрыв страницы
    IsEmptyPara = (Len(t) = 0)
End Function

' Универсальная замена
Sub GlobalReplace(rngTarget As Range, fText As String, rText As String, wildcards As Boolean)
    Dim r As Range
    Set r = Selection.Range
    With r.Find
        .ClearFormatting
        .Replacement.ClearFormatting
        .Text = fText
        .Replacement.Text = rText
        .MatchWildcards = wildcards
        .Forward = True
        .Wrap = wdFindStop
        .Execute Replace:=2
    End With
End Sub