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


Sub ВставитьТекстОчиститьИОформить()
    Dim rng As Range
    Dim para As Paragraph
    Dim colParas As Collection
    Dim i As Long

    ' 1. Запомнить начало
    Dim startPos As Long
    startPos = Selection.Start

    ' 2. Вставка текста из буфера
    On Error Resume Next
    Selection.PasteSpecial Link:=False, _
                           DataType:=wdPasteText, _
                           Placement:=wdInLine, _
                           DisplayAsIcon:=False
    If Err.Number <> 0 Then
        MsgBox "Не удалось вставить текст. Проверьте, скопированы ли данные."
        Exit Sub
    End If
    On Error GoTo 0

    ' 3. Выделить вставленный диапазон
    Selection.SetRange Start:=startPos, End:=Selection.End
    Set rng = Selection.Range

    ' 4. Полная очистка форматирования
    rng.ClearFormatting
    rng.ParagraphFormat.Reset

    ' 5. Обнулить интервалы и отступы
    With rng.ParagraphFormat
        .SpaceBefore = 0
        .SpaceAfter = 0
        .LineSpacingRule = wdLineSpaceSingle
        .FirstLineIndent = 0
        .LeftIndent = 0
        .RightIndent = 0
        .CharacterUnitFirstLineIndent = 0
        .CharacterUnitLeftIndent = 0
        .CharacterUnitRightIndent = 0
    End With

    ' 6. Шрифт Times New Roman, 11 пт
    With rng.Font
        .Name = "Times New Roman"
        .Size = 11
    End With

    ' 7. Первая буква каждого слова — заглавная
    rng.Case = wdTitleWord

    ' 8. Добавить по пустой строке сверху и снизу
    rng.InsertParagraphBefore   ' вставит пустой абзац перед текстом и расширит rng
    rng.InsertParagraphAfter    ' вставит пустой абзац после текста и расширит rng

    ' 9. Применить тот же шрифт и интервалы к пустым строкам
    With rng.Font
        .Name = "Times New Roman"
        .Size = 11
    End With
    With rng.ParagraphFormat
        .SpaceAfter = 0
        .SpaceBefore = 0
    End With

    ' 10. Собрать непустые абзацы для нумерации
    Set colParas = New Collection
    For Each para In rng.Paragraphs
        If Len(para.Range.Text) > 1 Then  ' пустая строка содержит только символ конца абзаца
            colParas.Add para
        End If
    Next para

    ' 11. Пронумеровать: 1., 2. и т.д.
    i = 1
    For Each para In colParas
        para.Range.InsertBefore i & ". "
        i = i + 1
    Next para

    ' 12. Показать результат и снять выделение
    rng.Select
    Selection.Collapse Direction:=wdCollapseEnd
End Sub