Top-Themen

Aktuelle Themen (A bis Z)

Administrator.de FeedbackApache ServerAppleAssemblerAudioAusbildungAuslandBackupBasicBatch & ShellBenchmarksBibliotheken & ToolkitsBlogsCloud-DiensteClusterCMSCPU, RAM, MainboardsCSSC und C++DatenbankenDatenschutzDebianDigitiales FernsehenDNSDrucker und ScannerDSL, VDSLE-BooksE-BusinessE-MailEntwicklungErkennung und -AbwehrExchange ServerFestplatten, SSD, RaidFirewallFlatratesGoogle AndroidGrafikGrafikkarten & MonitoreGroupwareHardwareHosting & HousingHTMLHumor (lol)Hyper-VIconsIDE & EditorenInformationsdiensteInstallationInstant MessagingInternetInternet DomäneniOSISDN & AnaloganschlüsseiTunesJavaJavaScriptKiXtartKVMLAN, WAN, WirelessLinuxLinux DesktopLinux NetzwerkLinux ToolsLinux UserverwaltungLizenzierungMac OS XMicrosoftMicrosoft OfficeMikroTik RouterOSMonitoringMultimediaMultimedia & ZubehörNetzwerkeNetzwerkgrundlagenNetzwerkmanagementNetzwerkprotokolleNotebook & ZubehörNovell NetwareOff TopicOpenOffice, LibreOfficeOutlook & MailPapierkorbPascal und DelphiPeripheriegerätePerlPHPPythonRechtliche FragenRedHat, CentOS, FedoraRouter & RoutingSambaSAN, NAS, DASSchriftartenSchulung & TrainingSEOServerServer-HardwareSicherheitSicherheits-ToolsSicherheitsgrundlagenSolarisSonstige SystemeSoziale NetzwerkeSpeicherkartenStudentenjobs & PraktikumSuche ProjektpartnerSuseSwitche und HubsTipps & TricksTK-Netze & GeräteUbuntuUMTS, EDGE & GPRSUtilitiesVB for ApplicationsVerschlüsselung & ZertifikateVideo & StreamingViren und TrojanerVirtualisierungVisual StudioVmwareVoice over IPWebbrowserWebentwicklungWeiterbildungWindows 7Windows 8Windows 10Windows InstallationWindows MobileWindows NetzwerkWindows ServerWindows SystemdateienWindows ToolsWindows UpdateWindows UserverwaltungWindows VistaWindows XPXenserverXMLZusammenarbeit

Excel - VBA - Nummerierung

Mitglied: PixXel

PixXel (Level 1) - Jetzt verbinden

21.10.2009 um 13:51 Uhr, 6269 Aufrufe, 9 Kommentare

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?


01.
Dim iStartVal As Integer 
02.
Dim iSumPages As Integer 
03.
Dim iPageCount As Integer 
04.
 
05.
Private Sub Workbook_BeforePrint(Cancel As Boolean) 
06.
 
07.
iStartVal = Application.InputBox(Prompt:="Bitte geben Sie den Startwert der Nummerierung ein", _ 
08.
      Title:="Startwert eingeben", Type:=1) 
09.
 
10.
iSumPages = Application.InputBox(Prompt:="Wie viele Seiten sollen gedruckt werden?", _ 
11.
      Title:="Seitenanzahl eingeben", Type:=1) 
12.
 
13.
Do While iStartVal <= iSumPages 
14.
    iPageCount = iPageCount + 1 
15.
    Range("BlattNr") = iPageCount 
16.
    ActiveSheet.PrintOut 
17.
Loop 
18.
 
19.
End Sub
Mitglied: 76109
21.10.2009 um 14:43 Uhr
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
Bitte warten ..
Mitglied: 76109
21.10.2009 um 15:08 Uhr
Hallo nochmal!

Mit ein paar Tricks, könntest Du es dennoch so machen:
01.
Option Explicit 
02.
 
03.
Dim NoPrint As Boolean 
04.
 
05.
Private Sub Workbook_BeforePrint(Cancel As Boolean) 
06.
    Dim iStartVal As Integer, iSumPages As Integer, i As Integer 
07.
 
08.
    If NoPrint = True Then Exit Sub 
09.
     
10.
    Cancel = True 
11.
     
12.
    NoPrint = True 
13.
 
14.
    iStartVal = Application.InputBox(Prompt:="Bitte geben Sie den Startwert der Nummerierung ein", _ 
15.
      Title:="Startwert eingeben", Type:=1) 
16.
 
17.
    iSumPages = Application.InputBox(Prompt:="Wie viele Seiten sollen gedruckt werden?", _ 
18.
      Title:="Seitenanzahl eingeben", Type:=1) 
19.
     
20.
    If iStartVal <> 0 And iSumPages <> 0 Then 
21.
        For i = 0 To iSumPages - 1 
22.
            Range("AG4") = iStartVal + i:  ActiveSheet.PrintOut 
23.
        Next 
24.
    End If 
25.
     
26.
    NoPrint = False 
27.
End Sub
Gruß Dieter

[edit] Variablen geändert [/edit]
Bitte warten ..
Mitglied: PixXel
22.10.2009 um 09:45 Uhr
Genial! Tausend Dank für Deine Hilfe!
Ich wär bestimmt noch daran verzweifelt


Liebe Grüße

Tom
Bitte warten ..
Mitglied: PixXel
22.10.2009 um 10:29 Uhr
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?
Bitte warten ..
Mitglied: 76109
22.10.2009 um 10:35 Uhr
Hallo PixXel!

Zitat von PixXel:
Ich wär bestimmt noch daran verzweifelt
Das kann ich mir sehr gut vorstellen

Gruß Dieter
Bitte warten ..
Mitglied: 76109
22.10.2009 um 11:05 Uhr
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ötigst

Gruß Dieter
Bitte warten ..
Mitglied: 76109
22.10.2009 um 16:03 Uhr
Hallo PixXel!

Als ein Druckauftrag mit Sheet-Nummerierung, würde es so gehen
01.
Option Explicit 
02.
 
03.
Dim NoPrint As Boolean 
04.
 
05.
Private Sub Workbook_BeforePrint(Cancel As Boolean) 
06.
    Dim PrintArray As Variant, CleanArray As Variant 
07.
    Dim iStartVal As Integer, iSumPages As Integer, i As Integer 
08.
 
09.
    If NoPrint = True Then Exit Sub 
10.
     
11.
    Cancel = True 
12.
     
13.
    NoPrint = True 
14.
 
15.
    iStartVal = Application.InputBox(Prompt:="Bitte geben Sie den Startwert der Nummerierung ein", _ 
16.
      Title:="Startwert eingeben", Type:=1) 
17.
 
18.
    iSumPages = Application.InputBox(Prompt:="Wie viele Seiten sollen gedruckt werden?", _ 
19.
      Title:="Seitenanzahl eingeben", Type:=1) 
20.
     
21.
    If iStartVal <> 0 And iSumPages <> 0 Then 
22.
        ReDim PrintArray(iSumPages - 1):  ReDim CleanArray(1 To iSumPages - 1) 
23.
         
24.
        PrintArray(0) = ActiveSheet.Name 
25.
         
26.
        Range("AG4") = iStartVal 
27.
         
28.
        Application.ScreenUpdating = False 
29.
         
30.
        For i = 1 To iSumPages - 1 
31.
            ActiveSheet.Copy After:=ActiveSheet 
32.
            ActiveSheet.Name = "P#" & i 
33.
            PrintArray(i) = ActiveSheet.Name 
34.
            CleanArray(i) = ActiveSheet.Name 
35.
            Range("AG4") = iStartVal + i: 
36.
        Next 
37.
         
38.
        Sheets(PrintArray).PrintOut Copies:=1, Collate:=True 
39.
         
40.
        Application.DisplayAlerts = False 
41.
        Sheets(CleanArray).Delete 
42.
        Application.DisplayAlerts = True 
43.
         
44.
        Application.ScreenUpdating = True 
45.
    End If 
46.
     
47.
    NoPrint = False 
48.
End Sub

Gruß Dieter
Bitte warten ..
Mitglied: PixXel
23.10.2009 um 09:48 Uhr
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 ?

01.
Option Explicit 
02.
 
03.
Dim NoPrint As Boolean 
04.
Dim DoNum As Boolean 
05.
 
06.
Private Sub Workbook_BeforePrint(Cancel As Boolean) 
07.
 
08.
    Dim PrintArray As Variant 
09.
    Dim CleanArray As Variant 
10.
    Dim iStartVal As Integer 
11.
    Dim iSumPages As Integer 
12.
    Dim i As Integer 
13.
 
14.
    If NoPrint = True Then Exit Sub 
15.
     
16.
    Cancel = True 
17.
     
18.
    NoPrint = True 
19.
 
20.
    Application.Dialogs(xlDialogPrinterSetup).Show 
21.
     
22.
    iSumPages = Application.InputBox(Prompt:="Wie viele Seiten sollen gedruckt werden?", _ 
23.
        Title:="Seitenanzahl eingeben", Type:=1) 
24.
     
25.
    DoNum = MsgBox("Sollen die Blätter automatisch nummeriert werden?", vbQuestion + vbYesNo, "Nummerierung hinzufügen?") = vbYes 
26.
         
27.
    If DoNum Then iStartVal = Application.InputBox(Prompt:="Bitte geben Sie den Startwert der Nummerierung ein", _ 
28.
        Title:="Startwert eingeben", Type:=1) 
29.
 
30.
    If DoNum Then 
31.
        If iStartVal <> 0 And iSumPages <> 0 Then 
32.
            ReDim PrintArray(iSumPages - 1):  ReDim CleanArray(1 To iSumPages - 1) 
33.
            PrintArray(0) = ActiveSheet.Name 
34.
            Application.ScreenUpdating = False 
35.
            Range("BlattNr") = iStartVal 
36.
             
37.
            For i = 1 To iSumPages - 1 
38.
                ActiveSheet.Copy After:=ActiveSheet 
39.
                ActiveSheet.Name = "P#" & i 
40.
                PrintArray(i) = ActiveSheet.Name 
41.
                CleanArray(i) = ActiveSheet.Name 
42.
                Range("BlattNr") = iStartVal + i: 
43.
            Next 
44.
            Sheets(PrintArray).PrintOut Copies:=1, Collate:=True 
45.
            Application.DisplayAlerts = False 
46.
            Sheets(CleanArray).Delete 
47.
            Sheets(PrintArray(0)).Activate 
48.
            Application.DisplayAlerts = True 
49.
            Application.ScreenUpdating = True 
50.
        End If 
51.
    Else 
52.
        If iSumPages <> 0 Then 
53.
            Range("BlattNr") = "":  ActiveSheet.PrintOut Copies:=iSumPages, Collate:=True 
54.
        End If 
55.
    End If 
56.
         
57.
    NoPrint = False 
58.
     
59.
    Range("BlattNr") = "" 
60.
     
61.
End Sub
Bitte warten ..
Mitglied: 76109
23.10.2009 um 10:44 Uhr
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
Bitte warten ..
Ähnliche Inhalte
VB for Applications

Aus Excel speichern als PDF mit Nummerierung

gelöst Frage von TIM589VB for Applications3 Kommentare

Ich habe ein kleines Programm geschrieben, bei dem man mit einer Excel Vorlage eine Rechnung schreiben kann. Im Fenster, ...

VB for Applications

Per VBA oder Makro Nummerierung und Name aus DB eintragen

Frage von evolutionVB for Applications

Hallo, ich habe folgendes Anliegen. Ich suche eine Lösung um in Word und Excel-Dokumenten automatisch in der Fußzeile eine ...

Microsoft

Excel-Datei mit VBA speichern

gelöst Frage von 116408Microsoft6 Kommentare

Guten Tag Ich habe eine Excel-Datei, in der in D4 der Kundenname und in D11 das Projekt benennt wird. ...

Basic

Excel VBA enthält

Frage von AngelsBasic

Guten Tag Ich bin ganz neu in diesem Forum und hätte eine Frage. Wie kann ich bei diesem bestehenden ...

Neue Wissensbeiträge
Windows 10

USB Maus und Tastatur versagen Dienst unter Windows 10

Erfahrungsbericht von hardykopff vor 1 TagWindows 105 Kommentare

Da steht man ziemlich dumm da, wenn der PC sich wegen fehlender USB Tastatur und Maus nicht bedienen lässt. ...

Administrator.de Feedback
Update der Seite: Alles zentriert
Information von Frank vor 1 TagAdministrator.de Feedback18 Kommentare

Hallo User, die größte Änderung von Release 5.8 ist das Zentrieren der Webseite (auf großen Bildschirmen) und ein "Welcome"-Teaser ...

Humor (lol)

WhatsApp-Nachrichten endlich auch per Bluetooth versendbar

Information von BassFishFox vor 2 TagenHumor (lol)4 Kommentare

Genau darauf habe ich gewartet! ;-) Der beliebte Messaging-Dienst WhatsApp erhält eine praktische neue Funktion: Ab dem nächsten Update ...

Google Android

Googles "Android Enterprise Recommended" für Unternehmen

Information von kgborn vor 2 TagenGoogle Android3 Kommentare

Hier eine Information, die für Administratoren und Verantwortliche in Unternehmen, die für die Beschaffung und das Rollout von Android-Geräten ...

Heiß diskutierte Inhalte
Windows Netzwerk
WSUS4 und Windows 10 Updates automatisch installieren
Frage von sammy65Windows Netzwerk15 Kommentare

Hallo miteinander, ich habe mit einen neuen WSUS Server aufgesetzt Server 2016 darauf einen aktuellen WSUS. Grund, wir stellen ...

Speicherkarten
Vergessliche USB-Sticks?
Frage von hanheikSpeicherkarten14 Kommentare

Ich habe in den letzten Tagen 500 USB-Sticks mit Bilddateien bespielt. Obwohl ich die Dateien mit größter Sorgfalt kopiert ...

Windows Server
NTFS Berechtigungen Ordnerstruktur
Frage von hukahu23489Windows Server11 Kommentare

Hallo, ich bin seit kurzem in einer neuen IT-Abteilung und bin über das Berechtigungskonzept des Unternehmens sehr schockiert. Ich ...

Hyper-V
Hyper-V mit altem XEON-Server. Was ist falsch?
Frage von LollipopHyper-V11 Kommentare

Hallo Bin etwas frustriert. Kleinbetrieb, ca. 15 PC's, 2 Stk. Server mit einigen virtuellen PC's für Fernwartung, VaultServer für ...