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


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

    ' Запоминаем позицию курсора ДО вставки
    startPos = Selection.Start

    ' 1. Вставка из буфера как текст
    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

    ' 2. Выделяем ВЕСЬ только что вставленный текст
    Selection.SetRange Start:=startPos, End:=Selection.End

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

    ' 4. Принудительное обнуление интервалов и отступов
    With Selection.ParagraphFormat
        .SpaceBefore = 0
        .SpaceAfter = 0
        .LineSpacingRule = wdLineSpaceSingle
        .FirstLineIndent = 0
        .LeftIndent = 0
        .RightIndent = 0
        .CharacterUnitFirstLineIndent = 0
        .CharacterUnitLeftIndent = 0
        .CharacterUnitRightIndent = 0
    End With

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

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

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

    If colParas.Count = 0 Then
        Selection.Collapse Direction:=wdCollapseEnd
        Exit Sub
    End If

    ' Сохраняем диапазоны первого и последнего абзаца ДО нумерации
    Set rngFirst = colParas(1).Range.Duplicate
    Set rngLast = colParas(colParas.Count).Range.Duplicate

    ' 8. Нумерация: 1. , 2. и т.д.
    i = 1
    For Each para In colParas
        para.Range.InsertBefore i & ". "
        i = i + 1
    Next para

    ' 9. Вставляем пустую строку сверху перед первым пунктом
    rngFirst.InsertParagraphBefore

    ' 10. Вставляем пустую строку снизу ПОСЛЕ последнего пункта
    rngLast.InsertParagraphAfter

    ' 11. Очищаем форматирование у только что созданного нижнего абзаца
    '     (находим его, расширяя rngLast вниз на один абзац)
    Set rngAfter = rngLast.Duplicate
    rngAfter.Collapse Direction:=wdCollapseEnd
    rngAfter.MoveEnd Unit:=wdParagraph, Count:=1
    rngAfter.Select

    Selection.ClearFormatting
    Selection.ParagraphFormat.Reset
    With Selection.ParagraphFormat
        .SpaceBefore = 0
        .SpaceAfter = 0
        .LineSpacingRule = wdLineSpaceSingle
    End With

    ' 12. Снимаем выделение, курсор в конец
    Selection.Collapse Direction:=wdCollapseEnd
End Sub