☰

Erhöhen Sie fortlaufende Zahlen in 4 verschiedenen Zellen nach dem Drucken

tag-icon • tag-icon microsoft-excel worksheet-function vba printing
Erhöhen Sie fortlaufende Zahlen in 4 verschiedenen Zellen nach dem Drucken

Ich habe einen Beleg im Format 1/4 Letter erstellt und ihn viermal in ein einzelnes Arbeitsblatt kopiert (um Papier zu sparen) und möchte, dass er fortlaufend von 001 bis 100 ausgedruckt wird. Jeder Beleg sollte eine eindeutige Seriennummer haben: 001,002...100.

Wie kann ich fortlaufende Zahlen in 4 verschiedene Zellen eingeben, beispielsweise sind A1, C1, E1 und G1 meine Zellen mit den Nummern 001, 002, 003, 004, und jede Zahl nach jedem Ausdruck erhöhen?

Außerdem brauche ich die Möglichkeit, die Startnummer anzugeben.

Ich habe das hier im Internet gefunden, vielleicht ist das ein Anfang:

Sub IncrementPrint()

    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:", "Title")
    If TypeName(xCount) = "Boolean" Then Exit Sub
    If (xCount = "") Or (Not IsNumeric(xCount)) Or (xCount < 1) Then
        MsgBox "error entered, please enter again", vbInformation, "Title"
        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

Antwort1

Benutze das

Option Explicit

Public Sub IncrementPrint()
    Dim resp As Variant, scr As Boolean, i As Long, j As Long

On Error Resume Next
    resp = Application.InputBox(Prompt:="Please enter the number of copies to print:", _
                                Title:="Select Total Print Copies", Type:=1)
On Error GoTo 0

    If resp = False Then Exit Sub
    If resp < 1 Or resp > 100 Then
        MsgBox "Invalid number: " & resp & " (Enter 1 to 100)", vbExclamation, "Try Again"
        Exit Sub
    End If

    scr = Application.ScreenUpdating
    Application.ScreenUpdating = False
    j = 0
    For i = 1 To resp
        ActiveSheet.Range("A1").Value2 = " Company-00" & i + 0 + j
        ActiveSheet.Range("C1").Value2 = " Company-00" & i + 1 + j
        ActiveSheet.Range("E1").Value2 = " Company-00" & i + 2 + j
        ActiveSheet.Range("G1").Value2 = " Company-00" & i + 3 + j
        ActiveSheet.PrintOut
        j = j + 3
    Next i
    ActiveSheet.Range("A1,C1,E1,G1").ClearContents
    Application.ScreenUpdating = scr
End Sub

verwandte Informationen