---

Option Explicit

Sub PrintWithIncrementingNumber()

    Dim ws As Worksheet
    Dim cellNumber As Range
    Dim sheetList As String
    Dim sheetName As String
    Dim startNum As Variant
    Dim endNum As Variant
    Dim i As Long
    Dim sh As Worksheet
    Dim oldCalc As XlCalculation
    Dim printCount As Long

    ' Формирование списка листов
    For Each sh In ThisWorkbook.Worksheets
        sheetList = sheetList & sh.Name & vbCrLf
    Next sh

    ' Выбор листа
    sheetName = InputBox( _
        "Введите название листа для печати:" & vbCrLf & vbCrLf & _
        sheetList, _
        "Выбор листа")

    If sheetName = "" Then Exit Sub

    On Error Resume Next
    Set ws = ThisWorkbook.Worksheets(sheetName)
    On Error GoTo 0

    If ws Is Nothing Then
        MsgBox "Лист с таким названием не найден.", vbExclamation
        Exit Sub
    End If

    ' Начальный номер
    startNum = Application.InputBox( _
        "Введите начальный номер:", _
        "Нумерация печати", 1, Type:=1)

    If VarType(startNum) = vbBoolean Then Exit Sub

    If startNum < 1 Or startNum <> Fix(startNum) Then
        MsgBox "Введите целый начальный номер больше нуля."
        Exit Sub
    End If

    ' Конечный номер
    endNum = Application.InputBox( _
        "Введите конечный номер:", _
        "Нумерация печати", 10, Type:=1)

    If VarType(endNum) = vbBoolean Then Exit Sub

    If endNum < startNum Or endNum <> Fix(endNum) Then
        MsgBox "Конечный номер должен быть не меньше начального."
        Exit Sub
    End If

    ' Ячейка с номером
    Set cellNumber = ws.Range("X3")

    ' Подтверждение
    If MsgBox( _
        "Лист: " & ws.Name & vbCrLf & _
        "Начальный номер: " & startNum & vbCrLf & _
        "Конечный номер: " & endNum & vbCrLf & _
        "Количество экземпляров: " & _
        (endNum - startNum + 1) & vbCrLf & vbCrLf & _
        "Начать печать?", _
        vbYesNo + vbQuestion, "Подтверждение печати") <> vbYes Then
        Exit Sub
    End If

    oldCalc = Application.Calculation
    On Error GoTo PrintError

    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationAutomatic

    For i = CLng(startNum) To CLng(endNum)

        cellNumber.Value = i

        ' Пересчёт формул всей книги
        Application.CalculateFull

        Do While Application.CalculationState <> xlDone
            DoEvents
        Loop

        ' Печать выбранного листа
        ws.PrintOut Copies:=1

        printCount = printCount + 1

    Next i

    Application.Calculation = oldCalc
    Application.ScreenUpdating = True

    MsgBox "Печать завершена!" & vbCrLf & _
           "Лист: " & ws.Name & vbCrLf & _
           "Напечатано экземпляров: " & printCount, _
           vbInformation

    Exit Sub

PrintError:

    Application.Calculation = oldCalc
    Application.ScreenUpdating = True

    MsgBox "Ошибка: " & Err.Description & vbCrLf & _
           "Отправлено на печать: " & printCount, vbCritical

End Sub