pixxel
Goto Top

Excel - VBA - Nummerierung

Hallo!

Ich habe eine Inventur-Liste in Excel erstellt, die beim Ausdruck durchnummeriert werden soll.
Dabei habe ich mir vorgestellt, dass beim Drucken eine Abfrage erscheint, in der die Anzahl der zu druckenden Seiten und der Startwert der Nummerierung abgefragt werden soll.

Die Blatt-Nr soll dabei ins Feld AG4 (Bereichsname: BlattNr) geschrieben werden.

Ich hab auch schon ne Weile rumprobiert, komm aber nicht auf das Ergebnis.
Bei diesem Beispiel druckt er mir nur eine Seite mit der Blatt-Nr 3 aus.

Könnt mir da jemand nen Tipp geben?


Dim iStartVal As Integer
Dim iSumPages As Integer
Dim iPageCount As Integer

Private Sub Workbook_BeforePrint(Cancel As Boolean)

iStartVal = Application.InputBox(Prompt:="Bitte geben Sie den Startwert der Nummerierung ein", _  
      Title:="Startwert eingeben", Type:=1)  

iSumPages = Application.InputBox(Prompt:="Wie viele Seiten sollen gedruckt werden?", _  
      Title:="Seitenanzahl eingeben", Type:=1)  

Do While iStartVal <= iSumPages
    iPageCount = iPageCount + 1
    Range("BlattNr") = iPageCount  
    ActiveSheet.PrintOut
Loop

End Sub

Content-Key: 127629

Url: https://administrator.de/contentid/127629

Printed on: April 16, 2024 at 08:04 o'clock

Mitglied: 76109
76109 Oct 21, 2009 at 12:43:48 (UTC)
Goto Top
Hallo PixXel!

Das kann nicht funktionieren.

Das ist ein Fass ohne Boden. Du versuchst einen bereits fertigen Druckauftrag abzufangen und willst diesen umkrempeln und neu absenden (PrintOut), der wiederum abgefangen wird, um wieder umgekrempelt zu werden. Das nennt man Endlos-Schleifen.

Gruß Dieter
Mitglied: 76109
76109 Oct 21, 2009 at 13:08:03 (UTC)
Goto Top
Hallo nochmal!

Mit ein paar Tricks, könntest Du es dennoch so machen:
Option Explicit

Dim NoPrint As Boolean

Private Sub Workbook_BeforePrint(Cancel As Boolean)
    Dim iStartVal As Integer, iSumPages As Integer, i As Integer

    If NoPrint = True Then Exit Sub
    
    Cancel = True
    
    NoPrint = True

    iStartVal = Application.InputBox(Prompt:="Bitte geben Sie den Startwert der Nummerierung ein", _  
      Title:="Startwert eingeben", Type:=1)  

    iSumPages = Application.InputBox(Prompt:="Wie viele Seiten sollen gedruckt werden?", _  
      Title:="Seitenanzahl eingeben", Type:=1)  
    
    If iStartVal <> 0 And iSumPages <> 0 Then
        For i = 0 To iSumPages - 1
            Range("AG4") = iStartVal + i:  ActiveSheet.PrintOut  
        Next
    End If
    
    NoPrint = False
End Sub

Gruß Dieter

[edit] Variablen geändert [/edit]
Member: PixXel
PixXel Oct 22, 2009 at 07:45:21 (UTC)
Goto Top
Genial! Tausend Dank für Deine Hilfe!
Ich wär bestimmt noch daran verzweifelt face-smile


Liebe Grüße

Tom
Member: PixXel
PixXel Oct 22, 2009 at 08:29:59 (UTC)
Goto Top
Leider ist nun zwischen jedem gedruckten Blatt eine Pause von ca. 5 Sekunden, da alles als eigener Job gedruckt wird.
Gibt's dafür vielleicht auch eine Möglichkeit die Druckaufträge in einen gesammelten zusammenzufassen?
Mitglied: 76109
76109 Oct 22, 2009 at 08:35:49 (UTC)
Goto Top
Hallo PixXel!

Zitat von @PixXel:
Ich wär bestimmt noch daran verzweifelt face-smile
Das kann ich mir sehr gut vorstellenface-smile

Gruß Dieter
Mitglied: 76109
76109 Oct 22, 2009 at 09:05:06 (UTC)
Goto Top
Hallo PixXel!

Das ist irgendwie logisch, weil ja durch die jeweilige Sheetänderung (AG4) jeweils ein eigner Druckauftrag erfolgt.

Wenn Du die Seitenzahlen nicht über die Fußzeilen machen willst, dann fällt mir im Moment nur das ein:
Vor dem Druckauftrag - per Makro - Sheets-Kopien entsprechend der Seitenzahl erstellen und anschließend wieder löschen.

Denke mal drüber nach, wie Du es machen willst und nutze die Makroaufzeichnung für die entsprechende Code-Anpassung.

Ich muss jetzt leider weg. Von daher kann es dauern, falls Du Hilfe benötigstface-wink

Gruß Dieter
Mitglied: 76109
76109 Oct 22, 2009 at 14:03:56 (UTC)
Goto Top
Hallo PixXel!

Als ein Druckauftrag mit Sheet-Nummerierung, würde es so gehenface-wink
Option Explicit

Dim NoPrint As Boolean

Private Sub Workbook_BeforePrint(Cancel As Boolean)
    Dim PrintArray As Variant, CleanArray As Variant
    Dim iStartVal As Integer, iSumPages As Integer, i As Integer

    If NoPrint = True Then Exit Sub
    
    Cancel = True
    
    NoPrint = True

    iStartVal = Application.InputBox(Prompt:="Bitte geben Sie den Startwert der Nummerierung ein", _  
      Title:="Startwert eingeben", Type:=1)  

    iSumPages = Application.InputBox(Prompt:="Wie viele Seiten sollen gedruckt werden?", _  
      Title:="Seitenanzahl eingeben", Type:=1)  
    
    If iStartVal <> 0 And iSumPages <> 0 Then
        ReDim PrintArray(iSumPages - 1):  ReDim CleanArray(1 To iSumPages - 1)
        
        PrintArray(0) = ActiveSheet.Name
        
        Range("AG4") = iStartVal  
        
        Application.ScreenUpdating = False
        
        For i = 1 To iSumPages - 1
            ActiveSheet.Copy After:=ActiveSheet
            ActiveSheet.Name = "P#" & i  
            PrintArray(i) = ActiveSheet.Name
            CleanArray(i) = ActiveSheet.Name
            Range("AG4") = iStartVal + i:  
        Next
        
        Sheets(PrintArray).PrintOut Copies:=1, Collate:=True
        
        Application.DisplayAlerts = False
        Sheets(CleanArray).Delete
        Application.DisplayAlerts = True
        
        Application.ScreenUpdating = True
    End If
    
    NoPrint = False
End Sub

Gruß Dieter
Member: PixXel
PixXel Oct 23, 2009 at 07:48:33 (UTC)
Goto Top
Danke nochmal für Deine Hilfe Dieter!
Das funktioniert wunderbar.
Aber ein (für Dich) winziges Problem hab ich noch: Zeile 53 macht nicht was sie soll.
Falls keine Nummerierung gewünscht wird, soll er das Blatt trotzdem mehrmals drucken. Kommt aber nur eins raus.
Darf ich Dich noch einmal um eine Minute Deiner Freizeit bringen ? face-smile

Option Explicit

Dim NoPrint As Boolean
Dim DoNum As Boolean

Private Sub Workbook_BeforePrint(Cancel As Boolean)

    Dim PrintArray As Variant
    Dim CleanArray As Variant
    Dim iStartVal As Integer
    Dim iSumPages As Integer
    Dim i As Integer

    If NoPrint = True Then Exit Sub
    
    Cancel = True
    
    NoPrint = True

    Application.Dialogs(xlDialogPrinterSetup).Show
    
    iSumPages = Application.InputBox(Prompt:="Wie viele Seiten sollen gedruckt werden?", _  
        Title:="Seitenanzahl eingeben", Type:=1)  
    
    DoNum = MsgBox("Sollen die Blätter automatisch nummeriert werden?", vbQuestion + vbYesNo, "Nummerierung hinzufügen?") = vbYes  
        
    If DoNum Then iStartVal = Application.InputBox(Prompt:="Bitte geben Sie den Startwert der Nummerierung ein", _  
        Title:="Startwert eingeben", Type:=1)  

    If DoNum Then
        If iStartVal <> 0 And iSumPages <> 0 Then
            ReDim PrintArray(iSumPages - 1):  ReDim CleanArray(1 To iSumPages - 1)
            PrintArray(0) = ActiveSheet.Name
            Application.ScreenUpdating = False
            Range("BlattNr") = iStartVal  
            
            For i = 1 To iSumPages - 1
                ActiveSheet.Copy After:=ActiveSheet
                ActiveSheet.Name = "P#" & i  
                PrintArray(i) = ActiveSheet.Name
                CleanArray(i) = ActiveSheet.Name
                Range("BlattNr") = iStartVal + i:  
            Next
            Sheets(PrintArray).PrintOut Copies:=1, Collate:=True
            Application.DisplayAlerts = False
            Sheets(CleanArray).Delete
            Sheets(PrintArray(0)).Activate
            Application.DisplayAlerts = True
            Application.ScreenUpdating = True
        End If
    Else
        If iSumPages <> 0 Then
            Range("BlattNr") = "":  ActiveSheet.PrintOut Copies:=iSumPages, Collate:=True  
        End If
    End If
        
    NoPrint = False
    
    Range("BlattNr") = ""  
    
End Sub
Mitglied: 76109
76109 Oct 23, 2009 at 08:44:31 (UTC)
Goto Top
Hallo PixXel!

Das Problem hierbei ist, dass Excel (auch ohne Makro) je Kopie einen seperaten Druckauftrag erstellt und dann passiert das wieder mit den Pausen.

Also, ist es sinnvoller, die gleiche Methode mit wahlweiser Seitennummerierung zu verwenden.

Ausgehend von meinem Script ohne zusätzlichen Input. D.h. Startnummer 0 = Keine Seitennummerierung

müsstest Du nur folgendes ändern:

in Zeile 21
If iSumPages <> 0 Then
in Zeile 26 und Zeile 35:
If iStartVal <> 0 Then Range...

Gruß Dieter