Sub PasteFromExcelClean()
Dim dataObj As MSForms.DataObject
Dim clipText As String
Dim rng As Range
Dim par As Paragraph
' Получаем текст из буфера обмена
On Error Resume Next
Set dataObj = New 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