Note: The other languages of the website are Google-translated. Back to English
Увійти  \/ 
x
or
x
Реєстрація  \/ 
x

or

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

Припустимо, у мене є сторінка робочого аркуша, яку потрібно надрукувати в 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-2019 та 365. Підтримує всі мови. Простота розгортання на вашому підприємстві чи в організації. Повна функція 30-денної безкоштовної пробної версії. 60-денна гарантія повернення грошей.
вкладка kte 201905

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

  • Увімкніть редагування та читання на вкладках у Word, Excel, PowerPoint, Publisher, Access, Visio та Project.
  • Відкривайте та створюйте кілька документів на нових вкладках того самого вікна, а не в нових вікнах.
  • Збільшує вашу продуктивність на 50% та зменшує сотні клацань миші для вас щодня!
дно офісної таблиці
Say something here...
symbols left.
You are guest
or post as a guest, but your post won't be published automatically.
Loading comment... The comment will be refreshed after 00:00.
  • To post as a guest, your comment is unpublished.
    Ariane · 10 days ago
    If I have 4 coupons per sheets, what do I have to modify on this code so the number will be incremented between the coupons on the same sheet as well as from every page it prints (i.e: page 1 has coupons # 1 to 4, page 2 has coupons from 5 to 8, etc.)
  • To post as a guest, your comment is unpublished.
    Kel · 1 months ago
    how can i count on from say number 779?  Thank you for sharing this code and any advice you can offer.
  • To post as a guest, your comment is unpublished.
    Jennifer · 1 months ago
    HI
    After doing the formula and selecting F5 I just get pop up Go to Print Area and then have to put in a reference  and I have tried everything but your pop up asking for how many prints does not come up? Helppppp please

    • To post as a guest, your comment is unpublished.
      f5 · 1 months ago
      press F5 in the VB window not the excel window.
  • To post as a guest, your comment is unpublished.
    someone · 4 months ago
    God bless you and your soul man! you are a miracle :))
  • To post as a guest, your comment is unpublished.
    Shahzad · 6 months ago
    Thankyou very much for sharing above code. It is very helpful for everyone. Can we add some code more for increasing 8 numbers instead of 1 after prints?
    Waiting for your reply. 
    Thanks
  • To post as a guest, your comment is unpublished.
    jam · 7 months ago
    I was wondering if you can just straight print out the file after reopening and it still follows the sequential number?

    What I am currently doing is every time i open the file, ALT + F11 then F5 and indicate the number of copies . It will then print the file with the correct numbering, then just save again. and when I will reopen again, I just need to do same step.

    If there's a code where you can just straight print it out every time you open the file and it will still follow the sequential numbering?

    thanks in advance
  • To post as a guest, your comment is unpublished.
    jam · 7 months ago
    I was wondering if you can just straight print out the file after reopening and it still follows the sequential number?

    What I am currently doing is every time i open the file, ALT + F11 then F5 and indicate the number of copies . It will then print the file with the correct numbering, then just save again. and when I will reopen again, I just need to do same step.

    If there's a code where you can just straight print it out every time you open the file and it will still follow the sequential numbering?

    thanks in advance
  • To post as a guest, your comment is unpublished.
    Nadia · 1 years ago
    Is it also possible to add to this code, so that 2 copies are automatically printed?

    • To post as a guest, your comment is unpublished.
      Eric · 1 years ago
      I would think you could change this part:
      ActiveSheet.Range("A1").Value = " Company-00" & I
      ActiveSheet.PrintOut

      to

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

      to get 2 copies of each one.
  • To post as a guest, your comment is unpublished.
    4g · 1 years ago
    Great !! I am not a programmer but i managed to change the Cell ref and the uniq numbering i wanted. Worked superb for me God bless you!
  • To post as a guest, your comment is unpublished.
    suresh kumar · 1 years ago
    hi, my name is suresh i have a data in excel format without any serial number which likes an example a way bill. i need to take it as 100 pages print and need to print the serial number what ever i need from a 4 digit but while printing i have to do in manual way. can u explain who to print auto generate the serial number code while printing
  • To post as a guest, your comment is unpublished.
    TBOne · 2 years ago
    I was wondering how to make a small change so that it prints 1 of 10, 2 of 10, 3 of 10, etc.
    Otherwise this works great. Thanks.
  • To post as a guest, your comment is unpublished.
    unknown · 2 years ago
    hey i want to change number of K11 cell number after print to 1-2-3-4-5-6 etc pls can u help ? and also tell me how to call that function pls help
  • To post as a guest, your comment is unpublished.
    Ib Alsa · 2 years ago
    Is there a way to select what values I want to print? for example I printed sequence 1 to 30 but need to reprint sequence 15 to 19 again.
  • To post as a guest, your comment is unpublished.
    onebadmf196@gmail.com · 2 years ago
    Works good for printing incremental #'s. How do I print every 5th,10, when needed?
  • To post as a guest, your comment is unpublished.
    Arash · 3 years ago
    Thanks a million
  • To post as a guest, your comment is unpublished.
    jennifer · 3 years ago
    My cell is I3 and the number is 2298 when I try the (VBA code: Auto increment cell value after each printing:) it gives me 22981 how do I get it to 2298,2299,2300
    • To post as a guest, your comment is unpublished.
      Shahnawaz · 5 months ago
      Hi Jennifer,
      Try this

      Sub IncrementPrint()
      'updateby Extendoffice 20160530
      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.PrintOut
      ActiveSheet.Range("J18").Value = ActiveSheet.Range("J18").Value + 1
      Next
      'ActiveSheet.Range("J18").ClearContents'

      Application.ScreenUpdating = xScreen
      End If
      End Sub
    • To post as a guest, your comment is unpublished.
      tan chee ho · 3 years ago
      thank you very much, it works for me. And i manage to make a few minor change to suit my needs. Really Appreciate to your sharing.
    • To post as a guest, your comment is unpublished.
      skyyang · 3 years ago
      Hi, jennifer,
      To deal with your problem, please apply the following VBA code:
      Note: Please change the prefix text and number to your own.

      Sub IncrementPrint_Num()
      Dim xCount As Variant
      Dim xScreen As Boolean
      Dim I As Long
      Dim xStr As String
      Dim xInt As Integer
      On Error Resume Next
      xStr = "Company-" 'prefix text
      xInt = 2291 '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 = xStr & xInt
      ActiveSheet.PrintOut
      Next
      ActiveSheet.Range("A1").ClearContents
      Application.ScreenUpdating = xScreen
      End If
      End Sub

      Please try it, hope it can help you!
      • To post as a guest, your comment is unpublished.
        Giuseppe · 1 years ago
        Hi,
        very interesting even though I'm looking for a different solution that I couldn't find and even if I tried to customize the code couldn't achieve so far.
        Following your example I would need to print the same page 100 times, into the same PDF for example and on each page the page number incremented.
        AS I said tried the collate method but as I understood it allows you to print together if you need multiple copies of the same printout.
        thanks in advance
        Giuseppe
      • To post as a guest, your comment is unpublished.
        richard1026 · 2 years ago
        Hello can you help me with this? I want the xINT to be more than 5 digits. Everytime i put a number with 6 digits, the count goes back to 1. How can i prevent that?
  • To post as a guest, your comment is unpublished.
    Desmond · 3 years ago
    thank you for posting this, it is very helpful. My question is this: I have 2 different barcodes that need to be incremented on one page, how can I modify the code to do that?
  • To post as a guest, your comment is unpublished.
    Pieter · 3 years ago
    thank you for the above, really helpful. is it possible to save and remember the last value
    • To post as a guest, your comment is unpublished.
      skyyang · 3 years ago
      Hello, Pieter,
      To save and remember the last printed value when you print next time, you should apply the following VBA code:

      Sub IncrementPrint()
      Dim xCount As Variant
      Dim xScreen As Boolean
      Dim I As Long
      Dim xM As Long
      Dim xMNWS As Worksheet
      Dim xAWS As Worksheet
      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
      Set xAWS = ActiveSheet
      On Error GoTo EMarkNumberSheet
      Set xMNWS = Sheets("IncrementPrint_MarkNumberSheet")
      EMarkNumberSheet:
      If xMNWS Is Nothing Then
      Set xMNWS = Application.Worksheets.Add(Type:=xlWorksheet)
      xMNWS.Name = "IncrementPrint_MarkNumberSheet"
      xMNWS.Range("A1").Value = 0
      xM = 0
      xMNWS.Visible = xlSheetVeryHidden
      Else
      xM = xMNWS.Range("A1").Value
      End If
      Application.ScreenUpdating = False
      For I = 1 To xCount
      xM = xM + 1
      xAWS.Range("A1").Value = " Company-00" & xM
      xAWS.PrintOut
      Next
      xMNWS.Range("A1").Value = xM
      xAWS.Range("A1").ClearContents
      Application.ScreenUpdating = xScreen
      End If
      End Sub

      If you need to reset the printed number to the default number, please run the below code firstly, and then execute the above code to print.

      Sub IncrementPrint_Reinstall()
      Dim xMNWS As Worksheet
      On Error GoTo EMarkNumberSheet
      Set xMNWS = Sheets("IncrementPrint_MarkNumberSheet")
      EMarkNumberSheet:
      If Not xMNWS Is Nothing Then
      Application.DisplayAlerts = False
      xMNWS.Visible = xlSheetHidden
      xMNWS.Delete
      Application.DisplayAlerts = True
      End If
      End Sub
      • To post as a guest, your comment is unpublished.
        jovz · 1 months ago
        Hi, thank you for this code.. I have a question. I used this code but the series are jumping like 0071,0072,0073. happened like 3x between series 1-100. So i closed the vba without saving re install the code but it print the last series that was saved (0032). My question is how can I print continuously without the series jumping and how can I reprint again starting on 101? will really appreciate your answer. sorry for this. I am not a programmer, I hope you understand. Thank you! 
  • To post as a guest, your comment is unpublished.
    Sniper · 3 years ago
    printed like 30 copies but now i cant print, runned the script a lot of times but not working, dont do anything :(
  • To post as a guest, your comment is unpublished.
    romik · 4 years ago
    my serial number start with 227861 how can i print from
  • To post as a guest, your comment is unpublished.
    Kris · 4 years ago
    Sorry to ask this on a separate post... My serial numbers start with a ZERO, but when I run the program it eliminates the zeros. I tried to convert the number field to text, but that did not fix it. Other ideas?
    • To post as a guest, your comment is unpublished.
      Art · 4 years ago
      R-Click Cell, Format, Custom, Where it says 'General', replace that with as many Zeros as your serial number will be. This will force the amount of zeros needed in front of your serial number. If I have a group of serial numbers that are 10 digit serials, I enter 0000000000 in the Type field to get '0004563571' to display in the serial number field.
      • To post as a guest, your comment is unpublished.
        Kris · 4 years ago
        Thank you Art. I did try that but the barcode kept eliminating the leading zeros... even after doing a custom number format.
  • To post as a guest, your comment is unpublished.
    Kris · 4 years ago
    Thank you for posting this, it is very helpful. My question is this: I have 2 different barcodes that need to be incremented on one page, how can I modify the code to do that?
  • To post as a guest, your comment is unpublished.
    Abdul · 4 years ago
    I need serial numbers like IA1-055242, IA1-055243, IA1-055244 .....
  • To post as a guest, your comment is unpublished.
    Kerry · 4 years ago
    This code is amazing, it is exactly what I need, however, I was wondering if there is a way to start printing from the number that is entered in cell "A1"?
    For example, if I have printed 100 copies, on the next print run I will need to print from number 101 and count up from there.
    I have tried a few code adjustments but it only seems to take the number entered in the cell i.e. 101, add 1 and then the rest of the prints are stuck with that one number, i.e. 102...

    Your assistance would be greatly appreciated :-)
    • To post as a guest, your comment is unpublished.
      geniusman · 11 months ago
      Find attached the modified codes.

      And here it is in text:

      Sub IncrementPrint()
      'updateby Extendoffice
      Dim xEnd As Variant
      Dim xStart As Variant
      Dim xScreen As Boolean
      Dim I As Long
      On Error Resume Next
      LInput:
      xStart = Application.InputBox("Please enter the first number:", "Kutools for Excel")
      xEnd = Application.InputBox("Please enter the last number:", "Kutools for Excel")
      If TypeName(xCount) = "Boolean" Then Exit Sub
      If (xStart = "") Or (Not IsNumeric(xStart)) Or (xStart < 1) Then
      MsgBox "Error entered, please enter again", vbInformation, "Kutools for Excel"
      GoTo LInput
      Else
      xScreen = Application.ScreenUpdating
      Application.ScreenUpdating = False
      For I = xStart To xEnd
      ActiveSheet.Range("A1").Value = " Company-00" & I
      ActiveSheet.PrintOut
      Next
      ActiveSheet.Range("A1").ClearContents
      Application.ScreenUpdating = xScreen
      End If
      End Sub
    • To post as a guest, your comment is unpublished.
      Valentas · 4 years ago
      If you did't find a solution already you can edit line 17 of the code to this: ActiveSheet.Range("A1").Value = Range("A1").Value + 1
      This will ad +1 to the number you have in A1 cell.
      • To post as a guest, your comment is unpublished.
        guest · 4 years ago
        It does not send to my printer