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

 Як автоматично збільшити значення комірки після кожного друку?

Припустимо, у мене є сторінка робочого аркуша, яку потрібно надрукувати в 100 примірниках, клітинка А1 - це номер чека Компанія-001, тепер я хотів би, щоб кількість збільшувалася на 1 після кожного роздруківки. Це означає, що коли я надрукую другу копію, число буде автоматично збільшено до Company-002, третя копія, номер буде Company-003 ... сто копій, номер буде Company-100. Чи існує якась хитрість, щоб швидко та можливо вирішити цю проблему в Excel?

Автоматичне збільшення значення комірки після кожного друку за допомогою коду VBA


стрілка синя права міхур Автоматичне збільшення значення комірки після кожного друку за допомогою коду VBA

Зазвичай у Excel немає прямого способу вирішити це завдання, але тут я створив код VBA для вирішення цього питання.

1. Утримуйте клавішу ALT + F11 ключі, щоб відкрити Microsoft Visual Basic для додатків вікна.

2. Клацання Insert > Модуліта вставте наступний код у Модулі Вікно

Код 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 для Excel вирішує більшість ваших проблем і збільшує продуктивність на 80%

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

Вкладка Office забезпечує інтерфейс з вкладками для Office і значно спрощує вашу роботу

  • Увімкніть редагування та читання на вкладках у Word, Excel, PowerPoint, Publisher, Access, Visio та Project.
  • Відкривайте та створюйте кілька документів на нових вкладках того самого вікна, а не в нових вікнах.
  • Збільшує вашу продуктивність на 50% та зменшує сотні клацань миші для вас щодня!
дно офісної таблиці
Коментарі (51)
Поки немає оцінок. Оцініть першим!
Цей коментар був мінімізований модератором на сайті
Цей код дивовижний, це саме те, що мені потрібно, однак, мені було цікаво, чи є спосіб почати друк з числа, яке введено в клітинку «A1»? Наприклад, якщо я надрукував 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 exemple avoir A1= 153, je lance une print de 10 copies. J'ai dis feuilles imprimée de 154 à 164 ET je voudrais que le nombre de la cellule soit aussi 164.
Comme ça quand je relance une impression ça prend le chiffre dans A1.
J'aimerais aussi si possible na pas à avoir aller dans basic. je voudrais que la macro s'active directement via l'optionpress. Це можливо?
Цей коментар був мінімізований модератором на сайті
Привіт,

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

je voudrais si c'est possible par exemple A1=153 et faire unepress de 10 copies. donc je récupéré 10 показів numérotées de 154 à 164 ET je voudrais aussi que le 153 en A1 s'incrémente jusqu'à 164.

Je voudrais aussi si possible ne pas à avoir utiliser basic pour l'impression. je voudrais pouvoir declancher directement la macro en utilisant l'optionpress tout simplement.

Дякую за вашу допомогу
Цей коментар був мінімізований модератором на сайті
Привіт, kaji,
Щоб вирішити вашу проблему, застосуйте наведений нижче код:
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 як Boolean
Dim I As Long
On Error Resume Next
LInput:
xStart = Application.InputBox("Введіть перше число:", "Kutools для Excel")
xEnd = Application.InputBox("Введіть останнє число:", "Kutools для Excel")
Якщо TypeName(xCount) = "Boolean", Вийдіть із Sub
Якщо (xStart = "") або (Not IsNumeric(xStart)) або (xStart < 1) Тоді
MsgBox "Введена помилка, будь ласка, введіть ще раз", vbInformation, "Kutools для Excel"
Перейдіть до LInput
Ще
xScreen = Application.ScreenUpdating
Application.ScreenUpdating = Невірний
Для I = xStart To xEnd
ActiveSheet.Range("A1").Value = "Компанія-00" & I
ActiveSheet.PrintOut
Далі
ActiveSheet.Range("A1").ClearContents
Application.ScreenUpdating = xScreen
End If
End Sub
Цей коментар був мінімізований модератором на сайті
Мені потрібні серійні номери, такі як IA1-055242, IA1-055243, IA1-055244 .....
Цей коментар був мінімізований модератором на сайті
Дякую, що опублікували це, це дуже корисно. Моє запитання таке: у мене є 2 різних штрих-коду, які потрібно збільшити на одній сторінці, як я можу змінити код для цього?
Цей коментар був мінімізований модератором на сайті
Вибачте, що запитую про це в окремому дописі... Мої серійні номери починаються з НУЛЯ, але коли я запускаю програму, вона усуває нулі. Я спробував перетворити числове поле в текст, але це не виправило. Інші ідеї?
Цей коментар був мінімізований модератором на сайті
Клацніть R-клацніть «Ячейка», «Формат», «Власний», де написано «Загальні», замініть це на стільки нулів, скільки буде ваш серійний номер. Це встановить необхідну кількість нулів перед вашим серійним номером. Якщо у мене є група серійних номерів із 10 цифр, я вводжу 0000000000 у поле Тип, щоб отримати '0004563571' для відображення в полі серійного номера.
Цей коментар був мінімізований модератором на сайті
Дякую арт. Я спробував це, але штрих-код продовжував видаляти нулі на початку... навіть після виконання спеціального формату чисел.
Цей коментар був мінімізований модератором на сайті
мій серійний номер починається з 227861 як я можу друкувати з
Цей коментар був мінімізований модератором на сайті
надруковано 30 копій, але зараз я не можу роздрукувати, багато разів запускав сценарій, але не працює, нічого не роби :(
Цей коментар був мінімізований модератором на сайті
дякую за вищесказане, дуже корисно. чи можна зберегти і запам'ятати останнє значення
Цей коментар був мінімізований модератором на сайті
Привіт, Пітере,
Щоб зберегти та запам’ятати останнє надруковане значення під час наступного друку, слід застосувати такий код VBA:

Sub IncrementPrint()
Dim xCount як варіант
Dim xScreen як Boolean
Dim I As Long
Dim xM As Long
Dim xMNWS як робочий аркуш
Dim xAWS як робочий лист
On Error Resume Next
LInput:
xCount = Application.InputBox("Введіть кількість копій, які потрібно надрукувати:", "Kutools для Excel")
Якщо TypeName(xCount) = "Boolean", Вийдіть із Sub
Якщо (xCount = "") або (Not IsNumeric(xCount)) або (xCount < 1) Тоді
MsgBox "введена помилка, будь ласка, введіть ще раз", vbInformation, "Kutools для Excel"
Перейдіть до LInput
Ще
xScreen = Application.ScreenUpdating
Встановіть xAWS = ActiveSheet
Помилка Перейдіть до EMarkNumberSheet
Встановіть xMNWS = Sheets("IncrementPrint_MarkNumberSheet")
EMarkNumberSheet:
Якщо xMNWS ніщо, то
Встановіть xMNWS = Application.Worksheets.Add(Type:=xlWorksheet)
xMNWS.Name = "IncrementPrint_MarkNumberSheet"
xMNWS.Range("A1").Значення = 0
xM = 0
xMNWS.Visible = xlSheetVeryHidden
Ще
xM = xMNWS.Діапазон("A1").Значення
End If
Application.ScreenUpdating = Невірний
Для I = 1 До xCount
xM = xM + 1
xAWS.Range("A1").Value = "Компанія-00" і xM
xAWS.PrintOut
Далі
xMNWS.Діапазон("A1").Значення = xM
xAWS.Range("A1").ClearContents
Application.ScreenUpdating = xScreen
End If
End Sub

Якщо вам потрібно скинути надрукований номер до номера за замовчуванням, спочатку запустіть наведений нижче код, а потім виконайте наведений вище код для друку.

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

-------------------------------------------------- -------------------------------------------------- ----- Дякую, RNS
Цей коментар був мінімізований модератором на сайті
Моя клітинка — I3, а число — 2298, коли я намагаюся (код VBA: автоматично збільшувати значення комірки після кожного друку:), він дає мені 22981, як мені отримати його до 2298,2299,2300
Цей коментар був мінімізований модератором на сайті
Привіт, Дженніфер,
Щоб вирішити вашу проблему, застосуйте такий код VBA:
Примітка. Будь ласка, змініть текст і номер префікса на свої власні.

Sub IncrementPrint_Num()
Dim xCount як варіант
Dim xScreen як Boolean
Dim I As Long
Dim xStr як рядок
Dim xInt як ціле число
On Error Resume Next
xStr = "Компанія-" 'текст префікса
xInt = 2291 'число
LInput:
xCount = Application.InputBox("Введіть кількість копій, які потрібно надрукувати:", "Kutools для Excel")
Якщо TypeName(xCount) = "Boolean", Вийдіть із Sub
Якщо (xCount = "") або (Not IsNumeric(xCount)) або (xCount < 1) Тоді
MsgBox "введена помилка, будь ласка, введіть ще раз", vbInformation, "Kutools для Excel"
Перейдіть до LInput
Ще
xScreen = Application.ScreenUpdating
Application.ScreenUpdating = Невірний
Для I = 1 До xCount
xInt = xInt + 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 як Boolean
Dim I As Long
On Error Resume Next
LInput:
xCount = Application.InputBox("Введіть кількість копій, які потрібно надрукувати:", "Kutools для Excel")
Якщо TypeName(xCount) = "Boolean", Вийдіть із Sub
Якщо (xCount = "") або (Not IsNumeric(xCount)) або (xCount < 1) Тоді
MsgBox "введена помилка, будь ласка, введіть ще раз", vbInformation, "Kutools для Excel"
Перейдіть до LInput
Ще
xScreen = Application.ScreenUpdating
Application.ScreenUpdating = Невірний
Для I = 1 До xCount

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

Application.ScreenUpdating = xScreen
End If
End Sub
Цей коментар був мінімізований модератором на сайті
Завдяки мільйонів
Цей коментар був мінімізований модератором на сайті
Добре працює для друку інкрементальних #. Як друкувати кожні 5, коли потрібно?
Цей коментар був мінімізований модератором на сайті
Чи є спосіб вибрати, які значення я хочу надрукувати? наприклад, я надрукував послідовність з 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 = "Компанія-00" & I
ActiveSheet.PrintOut
ActiveSheet.PrintOut

щоб отримати по 2 примірники кожного з них.
Цей коментар був мінімізований модератором на сайті
Мені було цікаво, чи можна просто роздрукувати файл після повторного відкриття, і він все ще слідує за порядковим номером?
Зараз я роблю щоразу, коли відкриваю файл, ALT + F11, потім F5 і вказую кількість копій. Потім він надрукує файл із правильною нумерацією, а потім просто збереже знову. і коли я знову відкриюся, мені просто потрібно зробити той самий крок.
Якщо є код, за яким ви можете просто роздрукувати його щоразу, коли відкриваєте файл, і він все одно буде відповідати послідовній нумерації?
заранее спасибо
Цей коментар був мінімізований модератором на сайті
Мені було цікаво, чи можна просто роздрукувати файл після повторного відкриття, і він все ще слідує за порядковим номером?

Зараз я роблю щоразу, коли відкриваю файл, ALT + F11, потім F5 і вказую кількість копій. Потім він надрукує файл із правильною нумерацією, а потім просто збереже знову. і коли я знову відкриюся, мені просто потрібно зробити той самий крок.

Якщо є код, за яким ви можете просто роздрукувати його щоразу, коли відкриваєте файл, і він все одно буде відповідати послідовній нумерації?

заранее спасибо
Цей коментар був мінімізований модератором на сайті
Щиро дякую, що поділилися вищевказаним кодом. Це дуже корисно для всіх. Чи можемо ми додати ще трохи коду для збільшення 8 чисел замість 1 після друку? Чекаю на вашу відповідь. Спасибі
There are no comments posted here yet
Load More
Залишайте свої коментарі
Публікація як гість
×
Оцініть цю публікацію:
0   Персонажі
Рекомендовані місця

Слідуй за нами

Copyright © 2009 - WWW.extendoffice.com. | Всі права захищені. На основі ExtendOffice. | Карта сайту
Microsoft та логотип Office є товарними знаками або зареєстрованими товарними знаками Microsoft Corporation у США та / або інших країнах.
Захищений Sectigo SSL