---

' Объявляем переменную на уровне модуля, чтобы оба макроса её видели
Public InsertedRowCount As Long

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

    ' 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)
    End If

    numLines = UBound(linesArr) + 1
    If numLines > 0 Then
        If Len(Trim(linesArr(numLines - 1))) = 0 Then
            numLines = numLines - 1
        End If
    End If

    If numLines = 0 Then
        MsgBox "Не найдено ни одной строки текста.", vbInformation
        Exit Sub
    End If

    ' 3. Вставляем строки (сдвигаем всё вниз)
    Application.ScreenUpdating = False
    ActiveCell.Resize(numLines).EntireRow.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
    InsertedRowCount = numLines   ' Запоминаем, сколько вставили

    ' 4. Заполняем ячейки: номер в активный столбец, текст в соседний справа
    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)    ' "1. "
            textPart = Trim(Mid(lineText, dotPos + 2))
        Else
            numPart = ""
            textPart = lineText
        End If
        ActiveCell.Offset(i, 0).Value = numPart
        ActiveCell.Offset(i, 1).Value = textPart
    Next i

    ' 5. Назначаем ОДНУ команду отмены
    Application.OnUndo "Отменить вставку списка", "ОтменитьВставкуСписка"

    Application.ScreenUpdating = True
End Sub

Sub ОтменитьВставкуСписка()
    If InsertedRowCount <= 0 Then Exit Sub
    Application.ScreenUpdating = False
    ' Удаляем ровно столько строк, сколько было вставлено
    ActiveCell.Resize(InsertedRowCount).EntireRow.Delete
    InsertedRowCount = 0
    Application.ScreenUpdating = True
End Sub