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
' Запоминаем позицию курсора ДО вставки
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
' 8. Нумерация: перед каждым абзацем вставляем "1. ", "2. " и т.д.
i = 1
For Each para In colParas
para.Range.InsertBefore i & ". "
i = i + 1
Next para
' Сохраняем диапазон последнего абзаца (после вставки номеров)
Set rngLast = colParas(colParas.Count).Range.Duplicate
' 9. Добавляем пустую строку сверху (перед первым абзацем)
rngFirst.InsertParagraphBefore
' 10. Добавляем пустую строку снизу (после последнего абзаца)
rngLast.InsertParagraphAfter
' 11. Снять выделение, курсор в конец
Selection.Collapse Direction:=wdCollapseEnd
End Sub