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


Sub PasteAndClean()
    Dim startPos As Long, endPos As Long
    Dim rng As Range
    
    ' 1. Запоминаем позицию курсора до вставки
    startPos = Selection.Start
    
    ' 2. Вставляем из буфера как обычный текст
    Selection.PasteSpecial DataType:=wdPasteText, Placement:=wdInLine
    
    ' 3. Определяем конечную позицию после вставки
    endPos = Selection.End
    
    ' Проверка: если ничего не вставилось
    If endPos <= startPos Then
        MsgBox "В буфере нет текста или вставка не удалась.", vbExclamation
        Exit Sub
    End If
    
    ' 4. Создаём диапазон вставленного текста и выделяем его
    Set rng = ActiveDocument.Range(startPos, endPos)
    rng.Select
    
    ' 5. Преобразуем каждое слово в заглавную букву
    rng.Text = StrConv(rng.Text, vbProperCase)
    
    ' 6. Обрабатываем все абзацы внутри этого диапазона
    Dim para As Paragraph
    Dim i As Long
    
    For Each para In rng.Paragraphs
        With para
            ' --- Жёсткое обнуление ВСЕХ интервалов ---
            .SpaceBefore = 0
            .SpaceAfter = 0
            .SpaceAfterAuto = False
            .LineSpacingRule = wdLineSpaceSingle   ' одинарный межстрочный
            ' .LineSpacing = 12   ' если нужен фиксированный, раскомментируйте
        End With
        
        ' Убираем пробелы и табуляции в конце строки
        With para.Range
            If .Characters.Count > 1 Then
                .MoveEnd Unit:=wdCharacter, Count:=-1
                Do While .Characters.Count > 0 And _
                        (.Characters.Last = " " Or .Characters.Last = vbTab)
                    .Characters.Last.Delete
                Loop
            End If
        End With
    Next para
    
    ' 7. Удаляем пустые абзацы (лишние строки из Excel)
    For i = rng.Paragraphs.Count To 1 Step -1
        Set para = rng.Paragraphs(i)
        Dim txt As String
        txt = para.Range.Text
        txt = Replace(txt, " ", "")
        txt = Replace(txt, vbTab, "")
        If Len(txt) = 1 And Asc(txt) = 13 Then ' остался только маркер абзаца
            para.Range.Delete
        End If
    Next i
    
    MsgBox "✅ Готово! Интервал после абзаца = 0, лишние строки удалены, регистр исправлен.", vbInformation
End Sub