---

Sub ВставитьТекстСНумерацией()
    ' ==== Единая запись отмены (Ctrl+Z отменяет всё сразу) ====
    Dim undoRec As Object ' UndoRecord
    On Error Resume Next
    Set undoRec = Application.UndoRecord
    On Error GoTo 0
    If Not undoRec Is Nothing Then
        undoRec.StartCustomRecord "Вставить текст с нумерацией"
    End If

    Dim dataObj As Object
    Dim clipText As String
    Dim lines() As String
    Dim n As Long
    Dim i As Long
    Dim ws As Worksheet
    Dim r0 As Long, c0 As Long    ' исходная позиция активной ячейки
    Dim leftCol As Long           ' столбец для нумерации
    Dim rngData As Range
    Dim cell As Range

    ' 1. Получить текст из буфера обмена
    On Error Resume Next
    Set dataObj = CreateObject("New:{1C3B4210-F441-11CE-B9EA-00AA006B1A69}")
    If dataObj Is Nothing Then
        MsgBox "Не удалось получить доступ к буферу обмена."
        If Not undoRec Is Nothing Then undoRec.EndCustomRecord
        Exit Sub
    End If
    dataObj.GetFromClipboard
    clipText = dataObj.GetText
    On Error GoTo 0

    If Len(Trim(clipText)) = 0 Then
        MsgBox "Буфер обмена пуст или содержит не текст."
        If Not undoRec Is Nothing Then undoRec.EndCustomRecord
        Exit Sub
    End If

    ' 2. Разбить на строки (разделители: vbCrLf или vbLf)
    lines = Split(Replace(clipText, vbCrLf, vbLf), vbLf)
    ' Удалить пустые строки в конце
    Do While UBound(lines) >= 0 And Trim(lines(UBound(lines))) = ""
        ReDim Preserve lines(UBound(lines) - 1)
    Loop
    n = UBound(lines) + 1
    If n = 0 Then
        MsgBox "Не найдено ни одной непустой строки."
        If Not undoRec Is Nothing Then undoRec.EndCustomRecord
        Exit Sub
    End If

    Set ws = ActiveSheet
    r0 = ActiveCell.Row
    c0 = ActiveCell.Column

    ' 3. Вставить n строк ПЕРЕД активной ячейкой, чтобы не стереть данные ниже
    Application.ScreenUpdating = False
    If n > 0 Then
        ws.Rows(r0 & ":" & r0 + n - 1).Insert Shift:=xlDown
    End If

    ' 4. Вставить текст в столбец активной ячейки (c0), начиная с r0
    For i = 0 To n - 1
        ws.Cells(r0 + i, c0).Value = lines(i)
    Next i

    ' 5. Очистить формат и задать шрифт Times New Roman 11
    Set rngData = ws.Range(ws.Cells(r0, c0), ws.Cells(r0 + n - 1, c0))
    rngData.ClearFormats
    With rngData.Font
        .Name = "Times New Roman"
        .Size = 11
    End With

    ' 6. Сделать каждое слово с заглавной (Proper Case)
    For Each cell In rngData
        If Len(cell.Value) > 0 Then
            cell.Value = StrConv(cell.Value, vbProperCase)
        End If
    Next cell

    ' 7. Подготовить столбец для нумерации (слева от данных)
    If c0 = 1 Then
        ' Если активная ячейка в столбце A, вставляем новый столбец слева
        ws.Columns(1).Insert Shift:=xlToRight
        c0 = 2
        leftCol = 1
    Else
        leftCol = c0 - 1
    End If

    ' 8. Заполнить нумерацию в столбце leftCol (1. , 2. , ...)
    For i = 0 To n - 1
        ws.Cells(r0 + i, leftCol).Value = (i + 1) & "."
        ' Очистим формат для номеров и применим тот же шрифт
        With ws.Cells(r0 + i, leftCol)
            .ClearFormats
            .Font.Name = "Times New Roman"
            .Font.Size = 11
        End With
    Next i

    ' 9. Добавить пустую строку сверху
    ws.Rows(r0).Insert Shift:=xlDown
    ' Теперь данные начинаются со строки r0 + 1
    ' 10. Добавить пустую строку снизу
    ws.Rows(r0 + n + 1).Insert Shift:=xlDown  ' после последней строки данных
    ' (с учётом уже вставленной верхней строки)

    ' 11. Выделить первую ячейку с текстом
    ws.Cells(r0 + 1, c0).Activate

    Application.ScreenUpdating = True

    If Not undoRec Is Nothing Then undoRec.EndCustomRecord
    MsgBox "Вставлено " & n & " строк(и) с нумерацией и отступами."
End Sub