Sub ВставитьТекстОчиститьИОформить()
' ==== Единая запись отмены ====
Dim undoRec As UndoRecord
Set undoRec = Application.UndoRecord
undoRec.StartCustomRecord "Вставить и оформить список"
' ==============================
Dim startPos As Long
Dim i As Long
Dim para As Paragraph
Dim colParas As Collection
Dim rngFirst 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 "Не удалось вставить текст. Проверьте, скопированы ли данные."
undoRec.EndCustomRecord
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
undoRec.EndCustomRecord
Exit Sub
End If
' 8. Нумерация: 1. , 2. и т.д.
i = 1
For Each para In colParas
para.Range.InsertBefore i & ". "
i = i + 1
Next para
' 9. Обновляем диапазон первого абзаца после нумерации
Set rngFirst = colParas(1).Range.Duplicate
' 10. Вставляем пустую строку сверху перед первым пунктом
rngFirst.InsertParagraphBefore
' 11. Перемещаем курсор в конец вставленного текста (остаёмся внутри ячейки)
Selection.Collapse Direction:=wdCollapseEnd
' 12. Добавляем пустую строку снизу
Selection.TypeParagraph
' 13. Очищаем форматирование у только что созданного нижнего абзаца
Selection.ClearFormatting
Selection.ParagraphFormat.Reset
With Selection.ParagraphFormat
.SpaceBefore = 0
.SpaceAfter = 0
.LineSpacingRule = wdLineSpaceSingle
End With
' 14. Снимаем выделение, курсор в конце
Selection.Collapse Direction:=wdCollapseEnd
' ==== Завершаем единую запись отмены ====
undoRec.EndCustomRecord
' =======================================
End Sub