---

' ==================== В САМОМ ВЕРХУ МОДУЛЯ ====================
' Переменные для сохранения состояния перед вставкой
Private SavedRow As Long           ' номер строки активной ячейки до вставки
Private SavedCol As Long           ' номер столбца
Private SavedNumLines As Long      ' количество вставленных строк
Private SavedOldData As Variant    ' двумерный массив с данными, которые были до вставки
' =================================================================

Sub ВставитьСписокИзWordСНумерацией()
    Dim dataObj As Object, clipText As String, linesArr As Variant
    Dim i As Long, lineText As String, numPart As String, textPart As String
    Dim dotPos As Long, numLines As Long
    Dim ws As Worksheet
    Dim rngBefore As Range
    Dim arr As Variant

    ' 1. Читаем буфер обмена
    On Error Resume Next
    Set dataObj = CreateObject("New:{1C3B4210-F441-11CE-B9EA-00AA006B1A69}")
    If Err.Number <> 0 Then
        On Error GoTo 0
        Set dataObj = CreateObject("MSForms.DataObject")
    End If
    On Error GoTo 0

    If dataObj Is Nothing Then
        MsgBox "Не удалось получить доступ к буферу обмена.", vbExclamation
        Exit Sub
    End If

    dataObj.GetFromClipboard
    clipText = dataObj.GetText
    If Len(Trim(clipText)) = 0 Then
        MsgBox "Буфер обмена пуст или содержит не текст.", vbInformation
        Exit Sub
    End If

    ' 2. Разбиваем на строки
    linesArr = Split(clipText, vbCrLf)
    If UBound(linesArr) < 0 Then linesArr = Split(clipText, vbLf)

    numLines = UBound(linesArr) + 1
    If numLines > 0 Then
        If Len(Trim(linesArr(numLines - 1))) = 0 Then numLines = numLines - 1
    End If
    If numLines = 0 Then
        MsgBox "Не найдено ни одной строки текста.", vbInformation
        Exit Sub
    End If

    ' 3. Сохраняем состояние ячеек, КОТОРЫЕ БУДУТ ЗАТЁРТЫ
    Set ws = ActiveSheet
    SavedRow = ActiveCell.Row
    SavedCol = ActiveCell.Column
    SavedNumLines = numLines

    ' Область, которая сдвинется вниз (строки от активной и ниже на numLines строк)
    ' Мы сохраним данные из активной ячейки и на numLines-1 строк вниз, в двух столбцах
    Set rngBefore = ws.Range(ws.Cells(SavedRow, SavedCol), ws.Cells(SavedRow + numLines - 1, SavedCol + 1))
    If Not rngBefore Is Nothing Then
        SavedOldData = rngBefore.Value  ' сохраняем как массив
    Else
        SavedOldData = Empty
    End If

    ' 4. Вставляем строки (сдвиг вниз) и заполняем
    Application.ScreenUpdating = False
    ws.Rows(SavedRow & ":" & SavedRow + numLines - 1).Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove

    For i = 0 To numLines - 1
        lineText = linesArr(i)
        dotPos = InStr(lineText, ". ")
        If dotPos > 0 And IsNumeric(Left(lineText, dotPos - 1)) Then
            numPart = Left(lineText, dotPos + 1)
            textPart = Trim(Mid(lineText, dotPos + 2))
        Else
            numPart = ""
            textPart = lineText
        End If
        ws.Cells(SavedRow + i, SavedCol).Value = numPart
        ws.Cells(SavedRow + i, SavedCol + 1).Value = textPart
    Next i
    Application.ScreenUpdating = True

    ' 5. Никакого OnUndo — история остаётся нетронутой!
End Sub

Sub ОтменитьПоследнююВставкуСписка()
    If SavedNumLines <= 0 Then
        MsgBox "Нет данных для отмены последней вставки.", vbInformation
        Exit Sub
    End If

    Dim ws As Worksheet
    Set ws = ActiveSheet

    Application.ScreenUpdating = False

    ' 1. Удаляем строки, которые были вставлены
    ws.Rows(SavedRow & ":" & SavedRow + SavedNumLines - 1).Delete Shift:=xlUp

    ' 2. Восстанавливаем старые данные (если они были)
    If Not IsEmpty(SavedOldData) Then
        Dim rngRestore As Range
        Set rngRestore = ws.Range(ws.Cells(SavedRow, SavedCol), ws.Cells(SavedRow + SavedNumLines - 1, SavedCol + 1))
        rngRestore.Value = SavedOldData
    End If

    ' 3. Очищаем сохранённые переменные
    SavedNumLines = 0
    SavedOldData = Empty

    Application.ScreenUpdating = True
End Sub