Note: The other languages of the website are Google-translated. Back to English

 Как автоматически увеличивать значение ячейки после каждой печати?

Предположим, у меня есть страница рабочего листа, которую нужно распечатать в 100 копий, ячейка A1 - это контрольный номер Company-001, теперь я бы хотел, чтобы это число увеличивалось на 1 после каждой распечатки. Это означает, что когда я распечатаю вторую копию, номер будет увеличен до «Компания-002» автоматически, для третьей копии, номер будет «Компания-003»… сто копий, номер будет «Компания-100». Есть ли способ быстро и возможно решить эту проблему в Excel?

Автоматическое увеличение значения ячейки после каждой печати с кодом VBA


стрелка синий правый пузырь Автоматическое увеличение значения ячейки после каждой печати с кодом VBA

Обычно у вас нет прямого способа решить эту задачу в Excel, но здесь я создам код VBA для решения этой проблемы.

1. Удерживайте ALT + F11 , чтобы открыть Microsoft Visual Basic для приложений окно.

2. Нажмите Вставить > Модулии вставьте следующий код в Модули Окно.

Код VBA: автоматическое увеличение значения ячейки после каждой печати:

Sub IncrementPrint()
'updateby Extendoffice
    Dim xCount As Variant
    Dim xScreen As Boolean
    Dim I As Long
    On Error Resume Next
LInput:
    xCount = Application.InputBox("Please enter the number of copies you want to print:", "Kutools for Excel")
    If TypeName(xCount) = "Boolean" Then Exit Sub
    If (xCount = "") Or (Not IsNumeric(xCount)) Or (xCount < 1) Then
        MsgBox "error entered, please enter again", vbInformation, "Kutools for Excel"
        GoTo LInput
    Else
        xScreen = Application.ScreenUpdating
        Application.ScreenUpdating = False
        For I = 1 To xCount
            ActiveSheet.Range("A1").Value = " Company-00" & I
            ActiveSheet.PrintOut
        Next
        ActiveSheet.Range("A1").ClearContents
        Application.ScreenUpdating = xScreen
    End If
End Sub

3, Затем нажмите F5 нажмите клавишу для запуска этого кода, и появится диалоговое окно с напоминанием о вводе количества копий, которые вы хотите распечатать для текущего рабочего листа, см. снимок экрана:

приращение документа при печати 1

4. Нажмите OK и ваш текущий рабочий лист сейчас распечатывается, и в то же время напечатанные рабочие листы пронумерованы Company-001, Company-002, Company-003… в ячейке A1, как вам нужно.

Внимание: В приведенном выше коде ячейка A1 будут вставлены заказанные вами порядковые номера и исходное значение ячейки в A1 будет очищен. И "Компания-00»- это порядковый номер, вы можете изменить их по своему усмотрению.


Лучшие инструменты для работы в офисе

Kutools for Excel решает большинство ваших проблем и увеличивает вашу производительность на 80%

  • Снова использовать: Быстро вставить сложные формулы, диаграммы и все, что вы использовали раньше; Зашифровать ячейки с паролем; Создать список рассылки и отправлять электронные письма ...
  • Бар Супер Формулы (легко редактировать несколько строк текста и формул); Макет для чтения (легко читать и редактировать большое количество ячеек); Вставить в отфильтрованный диапазон...
  • Объединить ячейки / строки / столбцы без потери данных; Разделить содержимое ячеек; Объединить повторяющиеся строки / столбцы... Предотвращение дублирования ячеек; Сравнить диапазоны...
  • Выберите Дубликат или Уникальный Ряды; Выбрать пустые строки (все ячейки пустые); Супер находка и нечеткая находка во многих рабочих тетрадях; Случайный выбор ...
  • Точная копия Несколько ячеек без изменения ссылки на формулу; Автоматическое создание ссылок на несколько листов; Вставить пули, Флажки и многое другое ...
  • Извлечь текст, Добавить текст, Удалить по позиции, Удалить пробел; Создание и печать промежуточных итогов по страницам; Преобразование содержимого ячеек в комментарии...
  • Суперфильтр (сохранять и применять схемы фильтров к другим листам); Расширенная сортировка по месяцам / неделям / дням, периодичности и др .; Специальный фильтр жирным, курсивом ...
  • Комбинируйте книги и рабочие листы; Объединить таблицы на основе ключевых столбцов; Разделить данные на несколько листов; Пакетное преобразование xls, xlsx и PDF...
  • Более 300 мощных функций. Поддерживает Office/Excel 2007-2021 и 365. Поддерживает все языки. Простое развертывание на вашем предприятии или в организации. Полнофункциональная 30-дневная бесплатная пробная версия. 60-дневная гарантия возврата денег.
вкладка kte 201905

Вкладка Office: интерфейс с вкладками в Office и упрощение работы

  • Включение редактирования и чтения с вкладками в Word, Excel, PowerPoint, Издатель, доступ, Visio и проект.
  • Открывайте и создавайте несколько документов на новых вкладках одного окна, а не в новых окнах.
  • Повышает вашу продуктивность на 50% и сокращает количество щелчков мышью на сотни каждый день!
офисный дно
Сортировать комментарии по
Комментарии (51)
Оценок пока нет. Оцените первым!
Этот комментарий был сведен к минимуму модератором на сайте
Этот код потрясающий, это именно то, что мне нужно, однако мне было интересно, есть ли способ начать печать с числа, которое введено в ячейку «А1»? Например, если я напечатал 100 экземпляров, то при следующем тираже мне нужно будет печатать с номера 101 и считать оттуда. Я пробовал несколько корректировок кода, но кажется, что он берет только число, введенное в ячейку, т.е. 101, добавляет 1, а затем остальные отпечатки застревают с этим одним числом, т.е. 102... Ваша помощь будет очень признательна: -)
Этот комментарий был сведен к минимуму модератором на сайте
Если вы еще не нашли решение, вы можете отредактировать строку 17 кода следующим образом: ActiveSheet.Range("A1").Value = Range("A1").Value + 1
Это добавит +1 к номеру, указанному в ячейке A1.
Этот комментарий был сведен к минимуму модератором на сайте
Не отправляет на мой принтер
Этот комментарий был сведен к минимуму модератором на сайте
Привет,

en exécutant la macro ça efface le nombre de ma cellule.
Je voudrais par instance avoir A1 = 153, je lance une Impression de 10 копий. J'ai dis feuilles imprimée de 154 à 164 ET je voudrais que le nombre de la cellule soit aussi 164.
Comme са quand je relance ипе впечатление са prend ле chiffre данс A1.
J'aimerais aussi си возможно na pas à avoir aller dans basic. je voudrais Que la macro s'active Direction через l'option Impression. Это возможно?
Этот комментарий был сведен к минимуму модератором на сайте
Привет,

en exécutant la macro ça efface le nombre en A1.

je voudrais si c'наиболее возможный пример A1 = 153 и справедливый отпечаток де 10 копий. Donc Je Récupéré 10 Impressions numérotées de 154 à 164 ET je voudrais aussi que le 153 en A1 s'incrémente jusqu'à 164.

Je voudrais aussi си возможно не pas à avoir utiliser basic pour l'impression. je voudrais pouvoir declancher directement la macro en utilisant l'option imprement tout simplement.

Merci влить VOTRE помощник
Этот комментарий был сведен к минимуму модератором на сайте
Привет, Каджи,
Чтобы решить вашу проблему, примените приведенный ниже код:
Sub IncrementPrint_Num()
Dim xCount As Variant
Dim xScreen As Boolean
Dim I As Long
Dim xInt As Integer
On Error Resume Next
xInt = 153 'number
LInput:
xCount = Application.InputBox("Please enter the number of copies you want to print:", "Kutools for Excel")
If TypeName(xCount) = "Boolean" Then Exit Sub
If (xCount = "") Or (Not IsNumeric(xCount)) Or (xCount < 1) Then
MsgBox "error entered, please enter again", vbInformation, "Kutools for Excel"
GoTo LInput
Else
xScreen = Application.ScreenUpdating
Application.ScreenUpdating = False
For I = 1 To xCount
xInt = xInt + 1
ActiveSheet.Range("A1").Value = xInt
ActiveSheet.PrintOut
Next
Application.ScreenUpdating = xScreen
End If
End Sub

Пожалуйста, попробуйте, надеюсь, это поможет вам, если у вас есть какие-либо другие проблемы, пожалуйста, прокомментируйте здесь.
Этот комментарий был сведен к минимуму модератором на сайте
Найдите прикрепленные измененные коды.

А вот в тексте:
Sub IncrementPrint ()
'updateby Extendoffice
Dim xEnd как вариант
Dim xStart как вариант
Dim xScreen как логическое значение
Дим я пока
On Error Resume Next
LВвод:
xStart = Application.InputBox («Пожалуйста, введите первое число:», «Kutools для Excel»)
xEnd = Application.InputBox («Пожалуйста, введите последнее число:», «Kutools для Excel»)
Если TypeName(xCount) = "Boolean", то выйдите из Sub
Если (xStart = "") Или (Not IsNumeric(xStart)) Или (xStart < 1) Тогда
MsgBox «Введена ошибка, введите еще раз», vbInformation, «Kutools for Excel»
Перейти к LInput
Еще
xScreen = Application.ScreenUpdating
Приложение.ScreenUpdating = False
Для I = xStart To xEnd
ActiveSheet.Range("A1").Value = "Company-00" & I
ActiveSheet.PrintOut
Далее
ActiveSheet.Range("A1").ClearContents
Application.ScreenUpdating = xScreen
End If
End Sub
Этот комментарий был сведен к минимуму модератором на сайте
Мне нужны серийные номера типа IA1-055242, IA1-055243, IA1-055244.....
Этот комментарий был сведен к минимуму модератором на сайте
Спасибо, что опубликовали это, это очень полезно. Мой вопрос таков: у меня есть 2 разных штрих-кода, которые нужно увеличить на одной странице, как я могу изменить код для этого?
Этот комментарий был сведен к минимуму модератором на сайте
Извините, что спрашиваю об этом в отдельном посте... Мои серийные номера начинаются с НУЛЯ, но когда я запускаю программу, она удаляет нули. Я попытался преобразовать числовое поле в текст, но это не помогло. Другие идеи?
Этот комментарий был сведен к минимуму модератором на сайте
R-Click Cell, Format, Custom, где написано «Общие», замените это на столько нулей, сколько будет ваш серийный номер. Это заставит количество нулей, необходимое перед вашим серийным номером. Если у меня есть группа серийных номеров, представляющих собой 10-значные серийные номера, я ввожу 0000000000 в поле «Тип», чтобы получить «0004563571» для отображения в поле серийного номера.
Этот комментарий был сведен к минимуму модератором на сайте
Спасибо Арт. Я пробовал это, но штрих-код продолжал удалять начальные нули ... даже после создания пользовательского числового формата.
Этот комментарий был сведен к минимуму модератором на сайте
мой серийный номер начинается с 227861 как я могу печатать с
Этот комментарий был сведен к минимуму модератором на сайте
напечатал около 30 копий, но теперь я не могу печатать, много раз запускал скрипт, но он не работает, ничего не делайте :(
Этот комментарий был сведен к минимуму модератором на сайте
спасибо за вышесказанное, очень полезно. можно ли сохранить и запомнить последнее значение
Этот комментарий был сведен к минимуму модератором на сайте
Привет, Питер,
Чтобы сохранить и запомнить последнее напечатанное значение при следующей печати, вы должны применить следующий код VBA:

Sub IncrementPrint ()
Dim xCount как вариант
Dim xScreen как логическое значение
Дим я пока
Тусклый xM как долго
Dim xMNWS как рабочий лист
Dim xAWS как рабочий лист
On Error Resume Next
LВвод:
xCount = Application.InputBox («Пожалуйста, введите количество копий, которые вы хотите распечатать:», «Kutools for Excel»)
Если TypeName(xCount) = "Boolean", то выйдите из Sub
Если (xCount = "") Или (Not IsNumeric(xCount)) Или (xCount < 1) Тогда
MsgBox «Введена ошибка, введите еще раз», vbInformation, «Kutools for Excel»
Перейти к LInput
Еще
xScreen = Application.ScreenUpdating
Установите xAWS = ActiveSheet
При ошибке Перейти к EMarkNumberSheet
Установить xMNWS = Листы ("IncrementPrint_MarkNumberSheet")
EMarkNumberSheet:
Если xMNWS ничто, то
Установите xMNWS = Application.Worksheets.Add(Type:=xlWorksheet)
xMNWS.Name = "IncrementPrint_MarkNumberSheet"
xMNWS.Range("A1").Значение = 0
хМ = 0
xMNWS.Visible = кслшитверихидден
Еще
xM = xMNWS.Диапазон("A1").Значение
End If
Приложение.ScreenUpdating = False
Для I = 1 To xCount
хМ = хМ + 1
xAWS.Range("A1").Value = "Компания-00" и xM
xAWS.PrintOut
Далее
xMNWS.Range("A1").Значение = xM
xAWS.Range("A1").ClearContents
Application.ScreenUpdating = xScreen
End If
End Sub

Если вам нужно сбросить напечатанный номер на номер по умолчанию, сначала запустите приведенный ниже код, а затем выполните приведенный выше код для печати.

Подпрограмма IncrementPrint_Reinstall()
Dim xMNWS как рабочий лист
При ошибке Перейти к EMarkNumberSheet
Установить xMNWS = Листы ("IncrementPrint_MarkNumberSheet")
EMarkNumberSheet:
Если не xMNWS, то ничто
Приложение.DisplayAlerts = False
xMNWS.Visible = кслшитхидден
xMNWS.Удалить
Application.DisplayAlerts = True
End If
End Sub
Этот комментарий был сведен к минимуму модератором на сайте
Привет, спасибо за этот код. У меня есть вопрос. Я использовал этот код, но серия прыгает как 0071,0072,0073 3 1. произошло как 100 раза между сериями 0032-101. Поэтому я закрыл vba без сохранения, переустановил код, но он распечатал последнюю сохраненную серию (XNUMX). Мой вопрос: как я могу печатать непрерывно без скачков серии и как я могу снова перепечатать, начиная со XNUMX? будет очень признателен за ваш ответ. Прошу прощения. Я не программист, надеюсь, вы понимаете. Благодарю вас! 
Этот комментарий был сведен к минимуму модератором на сайте
спасибо за публикацию этого, это очень полезно. Мой вопрос таков: у меня есть 2 разных штрих-кода, которые нужно увеличить на одной странице, как я могу изменить код для этого?
Этот комментарий был сведен к минимуму модератором на сайте
Привет, Десмонд,
Если у вас есть 2 места на одной странице (например, 2 купона или 2 шаблона/2 ваучера и т. д.), вы можете попробовать использовать приведенный ниже код. (Предполагая, что ваш 1-й штрих-код и 2-й штрих-код находятся в ячейках «A1» и «A20» на одной странице, этот код будет увеличивать значения, такие как «Компания-001» и «Компания-002» на первой странице и «Компания-003» и «Компания-004» на второй странице. и т. д. Вы можете редактировать номер ячейки и название компании по своему усмотрению в строках 20, 21, 23, 24 и 28,29, XNUMX кода. 
Он также попросит вас ввести начальный и конечный номера (спасибо гению за эту часть кода). Так, например, ваш начальный номер. 1 и окончание №. 8, он напечатает 4 страницы 1,2 на 1-й странице, 3,4 на 2-й странице, 5,6 на 3-й странице и, наконец, 7,8 на 4-й странице. Надеюсь, это поможет вам или любому, кто ищет этот тип потребности/требования. 
Модифицированный код: -------------------------------------------------------------- ------------Подпрограмма IncrementPrint()
'updateby Extendoffice
Dim xEnd как вариант
Dim xStart как вариант
Dim xScreen как логическое значение
Дим я пока
On Error Resume Next
LВвод:
xStart = Application.InputBox («Пожалуйста, введите первое число:», «Kutools для Excel»)
xEnd = Application.InputBox («Пожалуйста, введите последнее число:», «Kutools для Excel»)
Если TypeName(xCount) = "Boolean", то выйдите из Sub
Если (xStart = "") Или (Not IsNumeric(xStart)) Или (xStart < 1) Тогда
MsgBox «Введена ошибка, введите еще раз», vbInformation, «Kutools for Excel»
Перейти к LInput
Еще
xScreen = Application.ScreenUpdating
Приложение.ScreenUpdating = False
Для I = xStart To xEnd
Если я Мод 2 = 0, то
ActiveSheet.Range("A1").Value = "Company-00" & I + 1
ActiveSheet.Range("A20").Value = "Company-00" & I
Еще
ActiveSheet.Range("A20").Value = "Company-00" & I + 1
ActiveSheet.Range("A1").Value = "Company-00" & I
ActiveSheet.PrintOut
End If
Далее
ActiveSheet.Range("A1").ClearContents
ActiveSheet.Range("A20").ClearContents
Application.ScreenUpdating = xScreen
End If
End Sub

-------------------------------------------------- -------------------------------------------------- -----Спасибо, РНС
Этот комментарий был сведен к минимуму модератором на сайте
Моя ячейка - I3, и число 2298, когда я пытаюсь (код VBA: значение ячейки с автоматическим увеличением после каждой печати :), это дает мне 22981, как мне получить его до 2298,2299,2300
Этот комментарий был сведен к минимуму модератором на сайте
Привет, Дженнифер,
Чтобы решить вашу проблему, примените следующий код VBA:
Примечание. Измените текст префикса и номер на свой собственный.

Sub IncrementPrint_Num()
Dim xCount как вариант
Dim xScreen как логическое значение
Дим я пока
Dim xStr как строка
Dim xInt как целое число
On Error Resume Next
xStr = "Компания-" 'текст префикса
xInt = 2291 'число
LВвод:
xCount = Application.InputBox («Пожалуйста, введите количество копий, которые вы хотите распечатать:», «Kutools for Excel»)
Если TypeName(xCount) = "Boolean", то выйдите из Sub
Если (xCount = "") Или (Not IsNumeric(xCount)) Или (xCount < 1) Тогда
MsgBox «Введена ошибка, введите еще раз», vbInformation, «Kutools for Excel»
Перейти к LInput
Еще
xScreen = Application.ScreenUpdating
Приложение.ScreenUpdating = False
Для I = 1 To xCount
хInt = хInt + 1
ActiveSheet.Range("A1").Value = xStr & xInt
ActiveSheet.PrintOut
Далее
ActiveSheet.Range("A1").ClearContents
Application.ScreenUpdating = xScreen
End If
End Sub

Пожалуйста, попробуйте, надеюсь, это поможет вам!
Этот комментарий был сведен к минимуму модератором на сайте
Привет, можешь помочь мне с этим? Я хочу, чтобы xINT было больше 5 цифр. Каждый раз, когда я ввожу число из 6 цифр, счет возвращается к 1. Как я могу предотвратить это?
Этот комментарий был сведен к минимуму модератором на сайте
Привет, очень интересно, хотя я ищу другое решение, которое я не смог найти, и даже если бы я попытался настроить код, пока не смог добиться этого. Следуя вашему примеру, мне нужно было бы распечатать одну и ту же страницу 100 раз, например, в один и тот же PDF-файл, и на каждой странице номер страницы увеличивается. Как я уже сказал, пробовал метод сопоставления, но, насколько я понял, он позволяет вам печатать вместе, если вам нужно несколько копий одной и той же распечатки. заранее спасибо Джузеппе
Этот комментарий был сведен к минимуму модератором на сайте
Привет, этот код работает отлично, но после значения ячейки 32767 он снова возвращается к 1. После этого значения он печатается с номера 1.
Этот комментарий был сведен к минимуму модератором на сайте
большое спасибо, это работает для меня. И мне удается внести несколько незначительных изменений в соответствии с моими потребностями. Очень ценю ваш обмен.
Этот комментарий был сведен к минимуму модератором на сайте
Привет Дженнифер, попробуй это
Sub IncrementPrint ()
'updateby Extendoffice 20160530
Dim xCount как вариант
Dim xScreen как логическое значение
Дим я пока
On Error Resume Next
LВвод:
xCount = Application.InputBox («Пожалуйста, введите количество копий, которые вы хотите распечатать:», «Kutools for Excel»)
Если TypeName(xCount) = "Boolean", то выйдите из Sub
Если (xCount = "") Или (Not IsNumeric(xCount)) Или (xCount < 1) Тогда
MsgBox «Введена ошибка, введите еще раз», vbInformation, «Kutools for Excel»
Перейти к LInput
Еще
xScreen = Application.ScreenUpdating
Приложение.ScreenUpdating = False
Для I = 1 To xCount

ActiveSheet.PrintOut
ActiveSheet.Range("J18").Value = ActiveSheet.Range("J18").Value + 1
Далее
'ActiveSheet.Range("J18").ClearContents'

Application.ScreenUpdating = xScreen
End If
End Sub
Этот комментарий был сведен к минимуму модератором на сайте
Благодаря млн.
Этот комментарий был сведен к минимуму модератором на сайте
Хорошо работает для печати инкрементных #. Как распечатать каждую 5-ю, 10-ю, когда это необходимо?
Этот комментарий был сведен к минимуму модератором на сайте
Есть ли способ выбрать, какие значения я хочу напечатать? например, я напечатал последовательность с 1 по 30, но мне нужно снова напечатать последовательность с 15 по 19.
Этот комментарий был сведен к минимуму модератором на сайте
эй, я хочу изменить номер ячейки K11 после печати на 1-2-3-4-5-6 и т. д. Пожалуйста, вы можете помочь? а также скажите мне, как вызвать эту функцию, пожалуйста, помогите
Этот комментарий был сведен к минимуму модератором на сайте
Мне было интересно, как сделать небольшое изменение, чтобы он печатал 1 из 10, 2 из 10, 3 из 10 и т. д.
В противном случае это прекрасно работает. Спасибо.
Этот комментарий был сведен к минимуму модератором на сайте
привет, меня зовут Суреш, у меня есть данные в формате Excel без серийного номера, который любит пример накладной. мне нужно распечатать 100 страниц, и мне нужно напечатать серийный номер, что мне нужно, из 4 цифр, но при печати я должен делать это вручную. не могли бы вы объяснить, кому печатать автоматически генерировать код серийного номера при печати
Этот комментарий был сведен к минимуму модератором на сайте
Большой !! Я не программист, но мне удалось изменить ссылку на ячейку и уникальную нумерацию, которую я хотел. Работал превосходно для меня, храни вас Бог!
Этот комментарий был сведен к минимуму модератором на сайте
Можно ли еще добавить к этому коду, чтобы 2 копии печатались автоматически?
Этот комментарий был сведен к минимуму модератором на сайте
Я думаю, вы могли бы изменить эту часть: ActiveSheet.Range("A1").Value = "Company-00" & I
ActiveSheet.PrintOut

в
ActiveSheet.Range("A1").Value = "Company-00" & I
ActiveSheet.PrintOut
ActiveSheet.PrintOut

чтобы получить по 2 копии каждого.
Этот комментарий был сведен к минимуму модератором на сайте
Мне было интересно, можете ли вы просто распечатать файл после повторного открытия, и он по-прежнему следует за порядковым номером?
Что я сейчас делаю, так это каждый раз, когда я открываю файл, ALT + F11, затем F5 и указываю количество копий. Затем он распечатает файл с правильной нумерацией, а затем просто сохранит его снова. и когда я снова откроюсь, мне просто нужно сделать тот же шаг.
Если есть код, в котором вы можете просто распечатывать его каждый раз, когда открываете файл, и он по-прежнему будет следовать последовательной нумерации?
заранее спасибо
Этот комментарий был сведен к минимуму модератором на сайте
Мне было интересно, можете ли вы просто распечатать файл после повторного открытия, и он по-прежнему следует за порядковым номером?

Что я сейчас делаю, так это каждый раз, когда я открываю файл, ALT + F11, затем F5 и указываю количество копий. Затем он распечатает файл с правильной нумерацией, а затем просто сохранит его снова. и когда я снова откроюсь, мне просто нужно сделать тот же шаг.

Если есть код, в котором вы можете просто распечатывать его каждый раз, когда открываете файл, и он по-прежнему будет следовать последовательной нумерации?

заранее спасибо
Этот комментарий был сведен к минимуму модератором на сайте
Большое спасибо за то, что поделились приведенным выше кодом. Это очень полезно для всех. Можем ли мы добавить еще код для увеличения 8 чисел вместо 1 после печати? Ждем вашего ответа. Спасибо
Здесь еще нет комментариев
Загрузить ещё
Оставляйте свои комментарии
Публикация как гость
×
Оценить этот пост:
0   Характеристики
Предлагаемые места

Подписывайтесь на Нас

Copyright © 2009 - www.extendoffice.ком. | Все права защищены. Питаться от ExtendOffice, | Карта сайта
Microsoft и логотип Office являются товарными знаками или зарегистрированными товарными знаками Microsoft Corporation в США и / или других странах.
Защищено Sectigo SSL