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


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