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