Загрузка данных


Sub ВставитьКакОчищенныйТекст()
    Dim rng As Range
    Dim startPos As Long
    
    ' Сохраняем позицию курсора до вставки
    startPos = Selection.Start
    
    ' Вставляем текст без форматирования
    On Error Resume Next
    Selection.PasteSpecial DataType:=wdPasteText
    If Err.Number <> 0 Then
        MsgBox "Нет данных для вставки.", vbExclamation
        Exit Sub
    End If
    On Error GoTo 0
    
    ' Создаём диапазон ровно по вставленному тексту
    Set rng = ActiveDocument.Range(startPos, Selection.End)
    
    ' 1. Полностью сбрасываем форматирование
    rng.ClearFormatting
    
    ' 2. Применяем стиль "Обычный" (сбрасывает стили абзацев)
    rng.Style = ActiveDocument.Styles(wdStyleNormal)
    
    ' 3. Настройка шрифта
    With rng.Font
        .Name = "Times New Roman"
        .Size = 11
    End With
    
    ' 4. Настройка абзаца – нулевые интервалы
    With rng.ParagraphFormat
        .SpaceBefore = 0
        .SpaceAfter = 0
        .LineSpacingRule = wdLineSpaceSingle
        .LeftIndent = 0
        .RightIndent = 0
        .FirstLineIndent = 0
        .CharacterUnitFirstLineIndent = 0
    End With
    
    ' 5. Удаляем пустые абзацы (два переноса подряд → один)
    With rng.Find
        .ClearFormatting
        .Text = "^p^p"
        .Replacement.Text = "^p"
        .Forward = True
        .Wrap = wdFindStop
        .Execute Replace:=wdReplaceAll
    End With
    
    ' 6. Каждое слово – с большой буквы
    rng.Case = wdTitleWord
End Sub