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

 Hur automatiskt ökar cellvärdet efter varje utskrift?

Om jag antar att jag har en arbetsbladssida som behövs för att skriva ut 100 exemplar, cellen A1 är kontrollnumret Företag-001, nu vill jag att antalet kommer att öka med 1 efter varje utskrift. Det betyder att när jag skriver ut det andra exemplaret kommer antalet automatiskt att ökas till Company-002, det tredje exemplet, numret blir Company-003 ... hundra exemplar, numret blir Company-100. Finns det något knep för att lösa detta problem i Excel snabbt och möjligen?

Autoinkrementera cellvärde efter varje utskrift med VBA-kod


pil blå höger bubbla Autoinkrementera cellvärde efter varje utskrift med VBA-kod

Normalt finns det inget direkt sätt för dig att lösa denna uppgift i Excel, men här skapar jag en VBA-kod för att hantera den.

1. Håll ner ALT + F11 nycklar för att öppna Microsoft Visual Basic för applikationer fönster.

2. Klicka Insert > Modulernaoch klistra in följande kod i Modulerna Fönster.

VBA-kod: Autoinkrementera cellvärde efter varje utskrift:

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. Tryck sedan på F5 nyckel för att köra den här koden och en snabbruta visas för att påminna dig om att ange antalet kopior som du vill skriva ut det aktuella kalkylbladet, se skärmdump:

dokumentsteg vid skrivning 1

4. Klicka OK -knappen och ditt nuvarande kalkylblad skrivs ut nu och samtidigt är de tryckta kalkylbladen numrerade Company-001, Company-002, Company-003 ... i cell A1 som du behöver.

Anmärkningar: I ovanstående kod, cellen A1 kommer att införas sekvensnumren som du beställde och det ursprungliga cellvärdet i A1 kommer att rensas. Och “Företag-00”Är sekvensnumret, du kan ändra dem efter behov.


De bästa Office-produktivitetsverktygen

Kutools för Excel löser de flesta av dina problem och ökar din produktivitet med 80%

  • återanvändning: Sätt snabbt i komplexa formler, diagram och allt som du har använt tidigare; Kryptera celler med lösenord; Skapa e-postlista och skicka e-post ...
  • Super Formula Bar (enkelt redigera flera rader med text och formel); Läslayout (enkelt läsa och redigera ett stort antal celler); Klistra in i filtrerat intervall...
  • Sammanfoga celler / rader / kolumner utan att förlora data; Delat cellinnehåll; Kombinera duplicerade rader / kolumner... Förhindra duplicerade celler; Jämför intervall...
  • Välj Duplicera eller Unikt Rader; Välj tomma rader (alla celler är tomma); Super Find och Fuzzy Find i många arbetsböcker; Slumpmässigt val ...
  • Exakt kopia Flera celler utan att ändra formelreferens; Skapa referenser automatiskt till flera ark; Sätt in kulor, Kryssrutor och mer ...
  • Extrahera text, Lägg till text, ta bort efter position, Ta bort mellanslag; Skapa och skriva ut personsökningstalsatser; Konvertera mellan celler innehåll och kommentarer...
  • Superfilter (spara och tillämpa filterscheman på andra ark); Avancerad sortering efter månad / vecka / dag, frekvens och mer; Specialfilter av fet, kursiv ...
  • Kombinera arbetsböcker och arbetsblad; Sammanfoga tabeller baserat på nyckelkolumner; Dela data i flera ark; Batchkonvertera xls, xlsx och PDF...
  • Mer än 300 kraftfulla funktioner. Stöder Office / Excel 2007-2021 och 365. Stöder alla språk. Enkel implementering i ditt företag eller organisation. Fullständiga funktioner 30 dagars gratis provperiod. 60 dagars pengarna tillbaka-garanti.
kte-flik 201905

Fliken Office ger ett flikgränssnitt till Office och gör ditt arbete mycket enklare

  • Aktivera flikredigering och läsning i Word, Excel, PowerPoint, Publisher, Access, Visio och Project.
  • Öppna och skapa flera dokument i nya flikar i samma fönster, snarare än i nya fönster.
  • Ökar din produktivitet med 50 % och minskar hundratals musklick för dig varje dag!
officetab botten
Sortera kommentarer efter
Kommentarer (51)
Inga betyg än. Bli först med att betygsätta!
Denna kommentar minimerades av moderatoren på webbplatsen
Den här koden är fantastisk, den är precis vad jag behöver, men jag undrade om det finns ett sätt att börja skriva ut från numret som anges i cell "A1"? Om jag till exempel har skrivit ut 100 exemplar måste jag vid nästa upplaga skriva ut från nummer 101 och räkna upp därifrån. Jag har försökt några kodjusteringar men det verkar bara ta numret som anges i cellen, dvs 101, lägg till 1 och sedan har resten av utskrifterna fastnat med det numret, dvs 102... Din hjälp skulle uppskattas mycket: -)
Denna kommentar minimerades av moderatoren på webbplatsen
Om du inte redan hittat en lösning kan du redigera rad 17 i koden till denna: ActiveSheet.Range("A1").Value = Range("A1").Value + 1
Detta kommer att annonsera +1 till numret du har i A1-cellen.
Denna kommentar minimerades av moderatoren på webbplatsen
Det skickas inte till min skrivare
Denna kommentar minimerades av moderatoren på webbplatsen
Hej!

en exécutant la macro ça efface le nombre de ma cellule.
Je voudrais par exemple avoir A1= 153, je lance une impression de 10 exemplar. 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 möjligt na pas à avoir aller dans basic. je voudrais que la macro s'active direction via l'option impression. Är det möjligt?
Denna kommentar minimerades av moderatoren på webbplatsen
Hej!

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

je voudrais si c'est possible par exemple A1=153 et faire une impression de 10 exemplar. 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 si possible ne pas à avoir utiliser basic pour l'impression. je voudrais pouvoir declancher directement la macro en utilisant l'option impression tout simplement.

Tack för din hjälp
Denna kommentar minimerades av moderatoren på webbplatsen
Hej kaji,
För att lösa ditt problem, använd följande kod:
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

Försök gärna, hoppas det kan hjälpa dig, om du har något annat problem, vänligen kommentera här.
Denna kommentar minimerades av moderatoren på webbplatsen
Hitta de modifierade koderna bifogade.

Och här är den i texten:
Sub IncrementPrint()
'uppdatering av Extendoffice
Dim xEnd som variant
Dim xStarta som variant
Dim xScreen As Boolean
Dim I As Long
On Error Resume Next
LInput:
xStart = Application.InputBox("Ange den första siffran:", "Kutools för Excel")
xEnd = Application.InputBox("Ange det sista numret:", "Kutools för Excel")
Om TypeName(xCount) = "Boolean" Avsluta Sub
Om (xStart = "") Eller (Not IsNumeric(xStart)) Eller (xStart < 1) Då
MsgBox "Fel angett, vänligen ange igen", vbInformation, "Kutools för Excel"
Gå till LInput
annars
xScreen = Application.ScreenUpdating
Application.ScreenUpdating = False
För I = xStart Till xEnd
ActiveSheet.Range("A1").Value = " Företag-00" & I
ActiveSheet.PrintOut
Nästa
ActiveSheet.Range("A1").ClearContents
Application.ScreenUpdating = xScreen
End If
End Sub
Denna kommentar minimerades av moderatoren på webbplatsen
Jag behöver serienummer som IA1-055242, IA1-055243, IA1-055244 .....
Denna kommentar minimerades av moderatoren på webbplatsen
Tack för att du postade detta, det är till stor hjälp. Min fråga är denna: Jag har 2 olika streckkoder som måste ökas på en sida, hur kan jag ändra koden för att göra det?
Denna kommentar minimerades av moderatoren på webbplatsen
Ledsen att jag frågar detta i ett separat inlägg... Mina serienummer börjar med en NOLL, men när jag kör programmet tar det bort nollorna. Jag försökte konvertera nummerfältet till text, men det löste det inte. Andra idéer?
Denna kommentar minimerades av moderatoren på webbplatsen
R-klicka på Cell, Format, Custom, där det står "Allmänt", ersätt det med så många nollor som ditt serienummer blir. Detta kommer att tvinga mängden nollor som behövs framför ditt serienummer. Om jag har en grupp serienummer som är 10-siffriga serier anger jag 0000000000 i fältet Typ för att få '0004563571' att visas i serienummerfältet.
Denna kommentar minimerades av moderatoren på webbplatsen
Tack Art. Jag försökte det men streckkoden tog bort de inledande nollorna... även efter att ha gjort ett anpassat nummerformat.
Denna kommentar minimerades av moderatoren på webbplatsen
mitt serienummer börjar med 227861 hur kan jag skriva ut från
Denna kommentar minimerades av moderatoren på webbplatsen
skrev ut typ 30 kopior men nu kan jag inte skriva ut, körde skriptet många gånger men fungerar inte, gör ingenting :(
Denna kommentar minimerades av moderatoren på webbplatsen
tack för ovanstående, verkligen hjälpsamt. är det möjligt att spara och komma ihåg det senaste värdet
Denna kommentar minimerades av moderatoren på webbplatsen
Hej Pieter,
För att spara och komma ihåg det senast utskrivna värdet när du skriver ut nästa gång, bör du använda följande VBA-kod:

Sub IncrementPrint()
Dim xCount As Variant
Dim xScreen As Boolean
Dim I As Long
Dim xM As Long
Dim xMNWS Som arbetsblad
Dim xAWS Som arbetsblad
On Error Resume Next
LInput:
xCount = Application.InputBox("Ange antalet kopior du vill skriva ut:", "Kutools för Excel")
Om TypeName(xCount) = "Boolean" Avsluta Sub
Om (xCount = "") Eller (Not IsNumeric(xCount)) Eller (xCount < 1) Då
MsgBox "fel angett, vänligen ange igen", vbInformation, "Kutools för Excel"
Gå till LInput
annars
xScreen = Application.ScreenUpdating
Ställ in xAWS = ActiveSheet
Vid fel Gå till EMarkNumberSheet
Ställ in xMNWS = Sheets("IncrementPrint_MarkNumberSheet")
EMarkNumberSheet:
Om xMNWS är ingenting då
Ställ in xMNWS = Application.Worksheets.Add(Type:=xlWorksheet)
xMNWS.Name = "InkrementPrint_MarkNumberSheet"
xMNWS.Range("A1").Value = 0
xM = 0
xMNWS.Visible = xlSheetVeryHidden
annars
xM = xMNWS.Range("A1").Värde
End If
Application.ScreenUpdating = False
För I = 1 Till xCount
xM = xM + 1
xAWS.Range("A1").Value = " Företag-00" & xM
xAWS.PrintOut
Nästa
xMNWS.Range("A1").Value = xM
xAWS.Range("A1"). ClearContents
Application.ScreenUpdating = xScreen
End If
End Sub

Om du behöver återställa det utskrivna numret till standardnumret, kör koden nedan först och kör sedan ovanstående kod för att skriva ut.

Sub IncrementPrint_Reinstall()
Dim xMNWS Som arbetsblad
Vid fel Gå till EMarkNumberSheet
Ställ in xMNWS = Sheets("IncrementPrint_MarkNumberSheet")
EMarkNumberSheet:
Om inte xMNWS är ingenting då
Application.DisplayAlerts = False
xMNWS.Visible = xlSheetHidden
xMNWS.Ta bort
Application.DisplayAlerts = Sant
End If
End Sub
Denna kommentar minimerades av moderatoren på webbplatsen
Hej, tack för den här koden.. Jag har en fråga. Jag använde den här koden men serien hoppar som 0071,0072,0073. hände typ 3x mellan serie 1-100. Så jag stängde vba utan att spara installera om koden men den skrev ut den senaste serien som sparades (0032). Min fråga är hur kan jag skriva ut kontinuerligt utan att serien hoppar och hur kan jag skriva ut igen från och med 101? kommer verkligen att uppskatta ditt svar. ledsen för det här. Jag är ingen programmerare, hoppas du förstår. Tack! 
Denna kommentar minimerades av moderatoren på webbplatsen
tack för att du postade detta, det är till stor hjälp. Min fråga är denna: Jag har 2 olika streckkoder som måste ökas på en sida, hur kan jag ändra koden för att göra det?
Denna kommentar minimerades av moderatoren på webbplatsen
Hej Desmond,
Om du har 2 platser på en sida (som 2 kuponger eller 2 mallar / 2 kuponger etc.), kan du prova att använda koden nedan. (Förutsatt att din första streckkod och andra streckkod finns i cellerna "A1" och "A2" på samma sida, kommer denna kod att öka värden som Företag-1 och Företag-20 på första sidan och Företag-001 och Företag-002 på andra sidan och så vidare Du kan redigera cellnummer och företagsnamn som du vill på raderna 003, 004, 20, 21 och 23 i koden. 
Den kommer också att be dig ange startnumret och slutnumret (Tack till geniusman för denna del av koden). Så till exempel ditt startnummer. är 1 och slutar nr. 8 kommer den att skriva ut 4 sidor av 1,2 på första sidan, 1 på andra sidan, 3,4 på tredje sidan och slutligen 2 på fjärde sidan. Hoppas det hjälper dig eller någon som söker denna typ av behov/krav. 
Ändrad kod:------------------------------------------------------ ------------Sub IncrementPrint()
'uppdatering av Extendoffice
Dim xEnd som variant
Dim xStarta som variant
Dim xScreen As Boolean
Dim I As Long
On Error Resume Next
LInput:
xStart = Application.InputBox("Ange den första siffran:", "Kutools för Excel")
xEnd = Application.InputBox("Ange det sista numret:", "Kutools för Excel")
Om TypeName(xCount) = "Boolean" Avsluta Sub
Om (xStart = "") Eller (Not IsNumeric(xStart)) Eller (xStart < 1) Då
MsgBox "Fel angett, vänligen ange igen", vbInformation, "Kutools för Excel"
Gå till LInput
annars
xScreen = Application.ScreenUpdating
Application.ScreenUpdating = False
För I = xStart Till xEnd
Om jag Mod 2 = 0 Då
ActiveSheet.Range("A1").Value = " Företag-00" & I + 1
ActiveSheet.Range("A20").Value = " Företag-00" & I
annars
ActiveSheet.Range("A20").Value = " Företag-00" & I + 1
ActiveSheet.Range("A1").Value = " Företag-00" & I
ActiveSheet.PrintOut
End If
Nästa
ActiveSheet.Range("A1").ClearContents
ActiveSheet.Range("A20").ClearContents
Application.ScreenUpdating = xScreen
End If
End Sub

-------------------------------------------------- -------------------------------------------------- -----Tack, RNS
Denna kommentar minimerades av moderatoren på webbplatsen
Min cell är I3 och numret är 2298 när jag försöker (VBA-kod: Automatiskt inkrementera cellvärde efter varje utskrift:) det ger mig 22981 hur får jag det till 2298,2299,2300
Denna kommentar minimerades av moderatoren på webbplatsen
Hej jennifer,
För att hantera ditt problem, använd följande VBA-kod:
Obs: Ändra prefixtexten och numret till ditt eget.

Sub IncrementPrint_Num()
Dim xCount As Variant
Dim xScreen As Boolean
Dim I As Long
Dim xStr As String
Dim xInt Som heltal
On Error Resume Next
xStr = "Företag-" 'prefix text
xInt = 2291 'nummer
LInput:
xCount = Application.InputBox("Ange antalet kopior du vill skriva ut:", "Kutools för Excel")
Om TypeName(xCount) = "Boolean" Avsluta Sub
Om (xCount = "") Eller (Not IsNumeric(xCount)) Eller (xCount < 1) Då
MsgBox "fel angett, vänligen ange igen", vbInformation, "Kutools för Excel"
Gå till LInput
annars
xScreen = Application.ScreenUpdating
Application.ScreenUpdating = False
För I = 1 Till xCount
xInt = xInt + 1
ActiveSheet.Range("A1").Value = xStr & xInt
ActiveSheet.PrintOut
Nästa
ActiveSheet.Range("A1").ClearContents
Application.ScreenUpdating = xScreen
End If
End Sub

Prova det, hoppas det kan hjälpa dig!
Denna kommentar minimerades av moderatoren på webbplatsen
Hej kan du hjälpa mig med detta? Jag vill att xINT ska vara mer än 5 siffror. Varje gång jag sätter ett nummer med 6 siffror går räkningen tillbaka till 1. Hur kan jag förhindra det?
Denna kommentar minimerades av moderatoren på webbplatsen
Hej, mycket intressant även om jag letar efter en annan lösning som jag inte kunde hitta och även om jag försökte anpassa koden kunde jag inte uppnå hittills. Efter ditt exempel skulle jag behöva skriva ut samma sida 100 gånger, i samma PDF till exempel och på varje sida ökade sidnumret. Som jag sa försökte sorteringsmetoden men som jag förstod låter den dig skriva ut tillsammans om du behöver flera kopior av samma utskrift.tack på förhand Giuseppe
Denna kommentar minimerades av moderatoren på webbplatsen
Hej, den här koden fungerar utmärkt, men efter 32767 cellvärde återgår den till 1. Efter detta värde skrivs den ut från nummer 1.
Denna kommentar minimerades av moderatoren på webbplatsen
tack så mycket, det fungerar för mig. Och jag lyckas göra några mindre ändringar för att passa mina behov. Uppskattar verkligen att du delar med dig.
Denna kommentar minimerades av moderatoren på webbplatsen
Hej Jennifer, testa detta
Sub IncrementPrint()
'uppdatering av Extendoffice 20160530
Dim xCount As Variant
Dim xScreen As Boolean
Dim I As Long
On Error Resume Next
LInput:
xCount = Application.InputBox("Ange antalet kopior du vill skriva ut:", "Kutools för Excel")
Om TypeName(xCount) = "Boolean" Avsluta Sub
Om (xCount = "") Eller (Not IsNumeric(xCount)) Eller (xCount < 1) Då
MsgBox "fel angett, vänligen ange igen", vbInformation, "Kutools för Excel"
Gå till LInput
annars
xScreen = Application.ScreenUpdating
Application.ScreenUpdating = False
För I = 1 Till xCount

ActiveSheet.PrintOut
ActiveSheet.Range("J18").Value = ActiveSheet.Range("J18").Value + 1
Nästa
'ActiveSheet.Range("J18").ClearContents'

Application.ScreenUpdating = xScreen
End If
End Sub
Denna kommentar minimerades av moderatoren på webbplatsen
Tack en miljon
Denna kommentar minimerades av moderatoren på webbplatsen
Fungerar bra för att skriva ut inkrementella #. Hur skriver jag ut var 5:e, 10:e vid behov?
Denna kommentar minimerades av moderatoren på webbplatsen
Finns det något sätt att välja vilka värden jag vill skriva ut? till exempel skrev jag ut sekvens 1 till 30 men måste skriva ut sekvens 15 till 19 igen.
Denna kommentar minimerades av moderatoren på webbplatsen
hej jag vill ändra antalet K11-cellnummer efter utskrift till 1-2-3-4-5-6 osv kan du hjälpa? och berätta också för mig hur man anropar den funktionen, snälla hjälp
Denna kommentar minimerades av moderatoren på webbplatsen
Jag undrade hur man gör en liten ändring så att den skriver ut 1 av 10, 2 av 10, 3 av 10 osv.
Annars fungerar detta utmärkt. Tack.
Denna kommentar minimerades av moderatoren på webbplatsen
hej, jag heter säkert att jag har en data i excel-format utan något serienummer som gillar ett exempel på fraktsedel. Jag måste ta det som 100 sidor skriva ut och måste skriva ut serienumret vad jag än behöver från en 4-siffrig men när jag skriver ut måste jag göra manuellt. kan du förklara vem som ska skriva ut automatiskt generera serienummerkoden under utskrift
Denna kommentar minimerades av moderatoren på webbplatsen
Bra !! Jag är inte en programmerare men jag lyckades ändra cellreferen och den unika numreringen jag ville ha. Funkade utmärkt för mig Gud välsigne dig!
Denna kommentar minimerades av moderatoren på webbplatsen
Går det också att lägga till denna kod, så att 2 exemplar skrivs ut automatiskt?
Denna kommentar minimerades av moderatoren på webbplatsen
Jag skulle tro att du kunde ändra den här delen: ActiveSheet.Range("A1").Value = " Företag-00" & I
ActiveSheet.PrintOut

till
ActiveSheet.Range("A1").Value = " Företag-00" & I
ActiveSheet.PrintOut
ActiveSheet.PrintOut

för att få 2 exemplar av varje.
Denna kommentar minimerades av moderatoren på webbplatsen
Jag undrar om du bara kan skriva ut filen direkt efter återöppning och den fortfarande följer sekvensnumret?
Det jag för närvarande gör är att varje gång jag öppnar filen, ALT + F11 sedan F5 och ange antalet kopior. Den kommer sedan att skriva ut filen med rätt numrering, sedan är det bara att spara igen. och när jag öppnar igen behöver jag bara göra samma steg.
Om det finns en kod där du bara kan skriva ut den direkt varje gång du öppnar filen och den fortfarande följer den sekventiella numreringen?
tack på förhand
Denna kommentar minimerades av moderatoren på webbplatsen
Jag undrar om du bara kan skriva ut filen direkt efter återöppning och den fortfarande följer sekvensnumret?

Det jag för närvarande gör är att varje gång jag öppnar filen, ALT + F11 sedan F5 och ange antalet kopior. Den kommer sedan att skriva ut filen med rätt numrering, sedan är det bara att spara igen. och när jag öppnar igen behöver jag bara göra samma steg.

Om det finns en kod där du bara kan skriva ut den direkt varje gång du öppnar filen och den fortfarande följer den sekventiella numreringen?

tack på förhand
Denna kommentar minimerades av moderatoren på webbplatsen
Tack så mycket för att du delar koden ovan. Det är till stor hjälp för alla. Kan vi lägga till lite kod mer för att öka 8 siffror istället för 1 efter utskrifter? Väntar på ditt svar. Tack
Det finns inga kommentarer här ännu
Ladda fler
Lämna dina kommentarer
Postar som gäst
×
Betygsätt detta inlägg:
0   Tecken
Föreslagna platser

Följ oss

Copyright © 2009 - www.extendoffice.com. | Alla rättigheter förbehållna. Drivs av ExtendOffice. | | Sitemap
Microsoft och Office-logotypen är varumärken eller registrerade varumärken som tillhör Microsoft Corporation i USA och / eller andra länder.
Skyddad av Sectigo SSL