Sub PasteFromExcelClean()
Dim dataObj As Object
Dim clipText As String
Dim rng As Range
Dim par As Paragraph
' Получаем текст из буфера обмена через позднее связывание
On Error Resume Next
Set dataObj = CreateObject("MSForms.DataObject")
dataObj.GetFromClipboard
clipText = dataObj.GetText
If Err.Number <> 0 Or clipText = "" Then
MsgBox "Буфер обмена пуст или содержит не текст.", vbExclamation
Exit Sub
End If
On Error GoTo 0
' Вставляем текст в место курсора (заменяем выделение)
Set rng = Selection.Range
If rng.Start <> rng.End Then rng.Delete
rng.Text = clipText
' Форматируем все абзацы вставленного блока
For Each par In rng.Paragraphs
par.SpaceAfter = 0 ' убираем интервал после абзаца
' Преобразуем каждое слово: первая заглавная, остальные строчные
par.Range.Text = StrConv(par.Range.Text, vbProperCase)
With par.Range.Font
.Name = "Times New Roman"
.Size = 11
End With
Next par
Selection.Collapse Direction:=wdCollapseEnd
End Sub