Загрузка данных


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