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


Sub PasteExcelCellsAsFormattedPlainText()
    ' Вставка содержимого буфера (только текст)
    Selection.PasteSpecial DataType:=wdPasteText

    Dim rng As Range
    Set rng = Selection.Range   ' только что вставленный текст

    ' ---------- 1. Шрифт Times New Roman, 11 пт ----------
    With rng.Font
        .Name = "Times New Roman"
        .Size = 11
    End With

    ' ---------- 2. Обработка абзацев (от последнего к первому) ----------
    Dim i As Long
    For i = rng.Paragraphs.Count To 1 Step -1
        Dim p As Paragraph
        Set p = rng.Paragraphs(i)

        ' Убираем отступы и интервалы
        p.SpaceAfter = 0
        p.SpaceBefore = 0
        p.LineSpacingRule = wdLineSpaceSingle

        ' Первые буквы слов — заглавные, остальные — строчные
        ' Сохраняем символ конца абзаца (vbCr), чтобы не сломать структуру
        Dim txt As String
        txt = p.Range.Text
        ' Удаляем символ конца абзаца (последний символ, обычно vbCr)
        If Len(txt) > 0 Then
            txt = Left$(txt, Len(txt) - 1)
        End If
        ' Преобразуем текст, затем возвращаем символ конца абзаца
        txt = StrConv(txt, vbProperCase) & vbCr
        p.Range.Text = txt
    Next i

    ' Снимаем выделение
    Selection.Collapse Direction:=wdCollapseEnd
End Sub