Live-Forum - Die aktuellen Beiträge
Datum
Titel
29.03.2024 13:14:12
28.03.2024 21:12:36
28.03.2024 18:31:49
Anzeige
Archiv - Navigation
1324to1328
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Inhaltsverzeichnis

Makrocode: Filter abfragen und drucken

Makrocode: Filter abfragen und drucken
19.08.2013 15:52:53
Hendrik
Hallo,
ich habe eine Datei in der für ca. 60 Lieferanten 4 Grafiken erstellt werden.
Jetzt interessiert es mich, ob und wie es möglich wäre, diese Grafiken für alle Lieferanten auszudrucken. Sprich, es müsste dann Lieferant 1 ausgewählt werden, die Grafiken gedruckt werden, dann Lieferant 2 ausgewählt werden und gedruckt werden.
Ist das möglich mit VBA?
Ein PDF-Druck wäre evtl als erste Schritt ebenfalls hilfreich, falls es Probleme mit Druckernamen geben sollte...
Wäre für jede Hilfe dankbar!
Grüße
Hendrik

14
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Makrocode: Filter abfragen und drucken
19.08.2013 18:38:25
fcs
Hallo Hendrik,
grundsätzlich funktioniert das per Makro.
Bleiben aber noch ein paar Fragen:
1. Wie werden die Daten für die Diagramme gefilter?
Autofilter (Filter wird auf Kunde/Kundennummer gesetzt und Zeilen ausgeblendet)
Pivottabellenbericht (Berichtsfilter oder Zeilenfilter wird gesetzt)
2. Wie sieht die Druckseite aus?
4 einzelne Diagrammblätter die jeweils auf eine Seite gedruckt
4 Diagramme auf einem Tabellenblatt, die mit vorgegebenem Druckbereich auf einer Seite gedruckt werden.
3. Gibt es in der Datei schon eine Liste der Kunden/Kundennummern?
Oder muss diese erst aus den vorhandenen Daten ermittelt werden?
Eine Beispieldatei mit anonymisierten Daten von 2 bis 3 Kunden wäre hilfreich,wenn man ein Makro für dich stricken soll.
Ob PDF-Datei oder Papierdruck ist bei Excel 2003 eigentlich egal, da alles über die Druck-Ausgabe läuft. Papierdruck ist eigentlich einfacher, da man sich nicht um die Dateinamen der PDF-Dateien kümmern muss. Du musst nur vor dem Start des Makros den gewünschten Drucker wählen bzw. der Zieldrucker wird vom Makro gesetzt.
Gruß
Franz

Anzeige
AW: Makrocode: Filter abfragen und drucken
20.08.2013 10:33:15
Hendrik
Hallo Franz,
Filterung erfolgt über einen, evtl auch 2 Berichtsfilter. Druckseite sind 2 Seiten, aber siehe selbst.
Alle Daten (lieferantennr) sind bereits vorhanden, diese müssten nur nacheinander abgefragt werden und dann eben gedruckt werden.
Leider funktioniert es gerade nicht, die Musterdatei hochzuladen. Das kommt also hoffentlich später...

AW: Makrocode: Filter abfragen und drucken
20.08.2013 12:52:02
Hendrik
https://www.herber.de/bbs/user/86934.xlsx
Hier endlich die Datei. Es sollte dann das gesamte Blatt in der die Grafik ist ausgedruckt werden, da hier im Original noch weitere Grafiken enthalten sind.
Aus B4 sollten dann alle Lieferantennummern nacheinander abgefragt werden und eben gedruckt.

Anzeige
AW: Makrocode: Filter abfragen und drucken
20.08.2013 15:24:16
fcs
Hallo Hendrik,
hier ein Makro, dass für die Ausgabe verschiedene Möglichkeiten hat:
1. Speichern als PDF für jede Kunden-Nr. (funktioniert ab Excel 2007)
2. Ausgabe als Postscript-Datei via FreePDF,
hier können natürlich auch andere Drucker eingestellt werden.
Die PS-Dateien können dann mit FreePDF, Acrobat-Distiller etc. weiter zu PDF-Dateien verarbeitet werden.
3. Ausgabe auf dem aktuell aktiven Drucker
Gruß
Franz
'Makro in einem allgemeinen Modul
'Erstellt unter Excel 2010 - Windows XP
Sub Drucken_KundenDiagramme()
Dim wksPivot As Worksheet
Dim pvTab As PivotTable, pvField As PivotField
Dim intKunde As Integer, rngKundenNr As Range
Dim objCollection As New Collection
Dim strPrinter As String, strDatei As String, strPfad As String
Dim bolPdf As Boolean
'Formate für Kundennummer und akteueles Datum/Zeit im PDF/PS-Dateinamen
Const cstrFormatKdnNr As String = "000000"
Const cstrFormatDatZeit As String = "YYYYMMDD hh_mm_ss"
On Error GoTo Fehler
strPfad = ActiveWorkbook.Path 'Verzeichnis für PDF bzw. Postscript-Dateien
strPrinter = Application.ActivePrinter
If MsgBox("zu jeder Kunden-Nr. eine PDF-Datei mit Diagrammen erstellen?" _
& vbLf & "(funktioniert erst ab Excel 2007!)", _
vbQuestion + vbYesNo, "Diagramme in PDF") = vbYes Then
bolPdf = True
Else
If MsgBox("Diagramme zu Kunden-Nrn. auf Drucker """ & strPrinter & """ drucken?", _
vbQuestion + vbOKCancel, "Diagramme drucken") = vbCancel Then Exit Sub
End If
Set wksPivot = ActiveWorkbook.Worksheets("Grafiken Lieferanten")
With ActiveWorkbook.Worksheets("Daten")
'Kunden-Nummern auslesen aus Spalte C ohne doppelte
For Each rngKundenNr In .Range(.Cells(2, 3), .Cells(.Rows.Count, 3).End(xlUp))
objCollection.Add rngKundenNr.Value, rngKundenNr.Text
Next rngKundenNr
End With
wksPivot.Activate
Range("A1").Select
'für jeden Kunden die Pivottabellenberichte im Blatt "Grafiken Lieferanten" _
aktualisieren und drucken
For intKunde = 1 To objCollection.Count
'Pivotbericht(e) zu Kunden-Nr. aktualisieren
Application.ScreenUpdating = False
For Each pvTab In wksPivot.PivotTables
Set pvField = pvTab.PageFields("Kunden Nr.")
pvField.CurrentPage = Val(objCollection.Item(intKunde))
pvTab.RefreshTable
Next pvTab
Application.ScreenUpdating = True
If bolPdf = True Then
'Tabellenblatt als PDF-Datei speichern
strDatei = strPfad & "\Diagramm_" _
& Format(Val(objCollection.Item(intKunde)), cstrFormatKdnNr) _
& "-" & Format(Now, cstrFormatDatZeit) & ".pdf"
wksPivot.ExportAsFixedFormat Type:=0, Filename:= _
strDatei, Quality:=xlQualityStandard, _
IncludeDocProperties:=True, IgnorePrintAreas:=False, _
OpenAfterPublish:=False 'Type:=0 = xlTypePDF
Else
If InStr(1, strPrinter, "FreePDF") > 0 Then
'Postscriptdatei erzeugen für Bearbeitung mit FreePDF-Join
strDatei = strPfad & "\Diagramm_" _
& Format(Val(objCollection.Item(intKunde)), cstrFormatKdnNr) _
& "-" & Format(Now, cstrFormatDatZeit) & ".ps"
wksPivot.PrintOut preview:=False, prtofilename:=strDatei
Else
'Ausgabe auf aktivem Drucker
wksPivot.PrintOut preview:=True 'für Produktionsbetrieb auf False setzen
End If
'Testzeile - später löschen/auskommentieren
If MsgBox("Nächstes Diagramm drucken?", vbQuestion + vbOKCancel, _
"Test-Anzeige - Diagramme drucken") = vbCancel Then Exit For
End If
Next intKunde
If bolPdf = True Then
MsgBox "Erstellte PDF-Dateien im Verzeichnis " & ActiveWorkbook.Path, _
vbOKOnly, "Fertig"
Else
If InStr(1, strPrinter, "FreePDF") > 0 Then
MsgBox "Postscript-Dateien erzeugt im Verzeichnis " & ActiveWorkbook.Path, _
vbOKOnly, "Fertig"
Else
MsgBox "Diagramm gedruckt auf " & strPrinter, vbOKOnly, "Fertig"
End If
End If
Fehler:
With Err
Select Case .Number
Case 0 'alles ok
Case 457 'doppelter Wert bei Collection.Add
Resume Next
Case Else
MsgBox "Fehler-Nr.: " & .Number & vbLf & .Description, _
vbInformation + vbOKOnly, "Makro: Drucken_KundenDiagramme"
End Select
End With
Application.ScreenUpdating = True
'Variablen aufräumen
Set wksPivot = Nothing
Set pvTab = Nothing: Set pvField = Nothing
Set rngKundenNr = Nothing
Set objCollection = Nothing
End Sub

Anzeige
AW: Makrocode: Filter abfragen und drucken
20.08.2013 16:22:09
Hendrik
Hallo Franz,
vielen Dank schonmal!
Kann ich das Makro auch nur auf dem aktuell aktiven Drucker drucken?Also nur einen bestimmten Teil nutzen?

AW: Makrocode: Filter abfragen und drucken
20.08.2013 20:56:51
fcs
Hallo Hendrik,
hier die abgespecke Version.
Gruß
Franz
'Makro in einem allgemeinen Modul
'Erstellt unter Excel 2010 - Windows XP/Windows Vista
Sub Drucken_KundenDiagramme()
Dim wksPivot As Worksheet
Dim pvTab As PivotTable, pvField As PivotField
Dim intKunde As Integer, rngKundenNr As Range
Dim objCollection As New Collection
Dim strPrinter As String
On Error GoTo Fehler
strPrinter = Application.ActivePrinter
If MsgBox("Diagramme zu Kunden-Nrn. auf Drucker """ & strPrinter & """ drucken?", _
vbQuestion + vbOKCancel, "Diagramme drucken") = vbCancel Then Exit Sub
Set wksPivot = ActiveWorkbook.Worksheets("Grafiken Lieferanten")
With ActiveWorkbook.Worksheets("Daten")
'Kunden-Nummern auslesen aus Spalte C ohne doppelte
For Each rngKundenNr In .Range(.Cells(2, 3), .Cells(.Rows.Count, 3).End(xlUp))
objCollection.Add rngKundenNr.Value, rngKundenNr.Text
Next rngKundenNr
End With
wksPivot.Activate
Range("A1").Select
'für jeden Kunden die Pivottabellenberichte im Blatt "Grafiken Lieferanten" _
aktualisieren und drucken
For intKunde = 1 To objCollection.Count
'Pivotbericht(e) zu Kunden-Nr. aktualisieren
Application.ScreenUpdating = False
For Each pvTab In wksPivot.PivotTables
Set pvField = pvTab.PageFields("Kunden Nr.")
'pvField.CurrentPage = CStr(objCollection.Item(intKunde))
pvField.CurrentPage = objCollection.Item(intKunde)
pvTab.RefreshTable
Next pvTab
Application.ScreenUpdating = True
'Ausgabe auf aktivem Drucker
wksPivot.PrintOut preview:=True 'für Produktionsbetrieb auf False setzen
'Testzeile - später löschen/auskommentieren
If MsgBox("Nächstes Diagramm drucken?", vbQuestion + vbOKCancel, _
"Test-Anzeige - Diagramme drucken") = vbCancel Then Exit For
Next intKunde
MsgBox "Diagramme gedruckt auf " & strPrinter, vbOKOnly, "Fertig"
Fehler:
With Err
Select Case .Number
Case 0 'alles ok
Case 457 'doppelter Wert bei Collection.Add
Resume Next
Case Else
MsgBox "Fehler-Nr.: " & .Number & vbLf & .Description, _
vbInformation + vbOKOnly, "Makro: Drucken_KundenDiagramme"
End Select
End With
Application.ScreenUpdating = True
'Variablen aufräumen
Set wksPivot = Nothing
Set pvTab = Nothing: Set pvField = Nothing
Set rngKundenNr = Nothing
Set objCollection = Nothing
End Sub

Anzeige
AW: Makrocode: Filter abfragen und drucken
21.08.2013 08:30:49
Hendrik
Danke Franz,
da in dem Makro steht: für Excel 2010, ich hier selber auch Excel 2010 habe, es aber auch für Excel 2003 funktionieren soll, nochmal kurz die Nachfrage, ob der Code auch in Excel 2003 laufen wird?

AW: Makrocode: Filter abfragen und drucken
21.08.2013 10:53:06
fcs
Hallo Hendrik,
lauffähig unter Excel 2003 und 2010:
Wahrscheinlich ja, da alle angesprochenen Funktion auch schon unter Version 2003 vorhanden sind.
Aber Probieren geht über Studieren. Man weiss nie ob Microsoft nicht doch irgend ein Ei in die neue Version gelegt hat.
Gruß
Franz

AW: Makrocode: Filter abfragen und drucken
21.08.2013 11:42:32
Hendrik
Hallo Franz,
es funktioniert soweit (zumindest erstmal in Excel 2010) : )
Allerdings müsste ich derzeit für jede Kundennummer das ok geben, wenn ich aber abbreche, dann wird komplett abgebrochen.
Könnte man es auch so gestalten, dass man noch "Überspringen" kann? Ansonsten müsste auch nicht jeder Kunde abgefragt werden, sondern es könnte für jeden Kunden ausgewählt werden.
Ideal wäre natürlich eine Liste, in der man auswählen könnte per Haken z.B., zu welchem Kunden man den Ausdruck benötigt.
Außerdem ist die Grafikseite so eingerichtet, dass sie ohne "Druckvorschau" gedruckt werden könnte.

Anzeige
AW: Makrocode: Filter abfragen und drucken
21.08.2013 17:15:45
fcs
Hallo Hendrik,
lies doch einfach mal die Kommentare im Code, dann erkennst du wo du die Anpassungen machen musst, damit ohne Seitenansicht und Abbruchmöglichkeit gearbeitte wird.
Ich hate diese beiden Optionen zum Testen eingebaut, damit man nicht ggf. berge von Altpapier produziert.
Wenn du nur eine Teilmenge aller Kunden drucken willst, dann musst du in einem Tabellenblatt eine Liste aller Kunden anlegen und in einer witeren Spalte die zu druckenden Kunden per "X" markieren.
Dies erfordert dann eine Anpassung in dem Abschnitt in dem die Liste der Kunden-Nummern zusammengestellt wird (objCollection gefüllt wird).
Gruß
Franz
Gruß
Franz

Anzeige
AW: Makrocode: Filter abfragen und drucken
22.08.2013 09:06:32
Hendrik
Hallo Franz,
so eine Kontrolle ist auf jeden Fall gut, deshalb möchte ich es ja auch über die Liste machen, da das dann doch schneller geht, als wenn man 60 Mal oder noch häufiger "Weiter" klickt oder auf "Drucken" klickt.
Habe jetzt in einer weiteren Tabelle (Name: Druckliste), in Spalte A die Kundennummern ab Zeile 4, in Spalte B ab Zeile 4 den Kundennamen dazu und in Spalte C dann die Auswahl durch setzen eines "X".
Wie müsste das denn dann in den Code integriert werden?
Vorher "traue" ich mich noch nicht, die anderen beiden Kontrollen herauszunehmen, da ich beim testen nicht soviel Altpapier produzieren möchte...
Wäre toll, wenn du mir nochmal helfen könntest.

Anzeige
AW: Makrocode: Filter abfragen und drucken
22.08.2013 11:42:55
fcs
Hallo Hendrik,
ich hab das Makro angepasst. Beim Testen traten dann verschiedenste Phänomene auf, wenn eine Kunden-Nr. noch nicht als Berichtsfilter vorhanden ist.
Deshalb wird vom Makro immer die Datenquelle (Spalten B bis M, allse Zeilen ab Zeile 1) der Pivotberichte aktualisiert.
Es wird geprüft, ob eine in der Druckliste gewählte Kundennummer auch im Blatt Daten in Spalte C vorhanden ist.
Gruß
Franz
'Makro in einem allgemeinen Modul
'Erstellt unter Excel 2010 - Windows XP/Windows Vista
Sub Drucken_KundenDiagramme_Auswahlliste()
Dim wksPivot As Worksheet
Dim pvTab As PivotTable, pvField As PivotField
Dim rngKunden As Range, rngKundenNr As Range
Dim strPrinter As String
Dim varCheck As Variant
On Error GoTo Fehler
strPrinter = Application.ActivePrinter
If MsgBox("Diagramme zu Kunden-Nrn. auf Drucker """ & strPrinter & """ drucken?", _
vbQuestion + vbOKCancel, "Diagramme drucken") = vbCancel Then Exit Sub
Set wksPivot = ActiveWorkbook.Worksheets("Grafiken Lieferanten")
With ActiveWorkbook.Worksheets("Druckliste")
'Bereich mit Kunden-Nummern der Objektvariblen zuweisen
Set rngKunden = .Range(.Cells(4, 1), .Cells(.Rows.Count, 1).End(xlUp))
End With
wksPivot.Activate
Range("A1").Select
Application.ScreenUpdating = False
'Alle Pivottabellen im Blatt aktualisieren, damit Auswahl für Berichtsfelder _
bei neuen Kunden/Daten in Liste vollständig
With Worksheets("Daten")
For Each pvTab In wksPivot.PivotTables
'Datenbereich für Datenquelle setzen (Spalten B bis M, Zeilen 1 bis letzte Zeile)
If Val(Left(Application.Version, 2)) >= 12 Then
'Excel 2007 und neuer
pvTab.SourceData = "'" & .Name & "'!" & .Range(.Cells(1, 2), _
.Cells(.Rows.Count, 2).End(xlUp).Offset(0, 11)).Address(ReferenceStyle:=xlR1C1)
Else
'Excel 2003 und alter - evtl. xlA1 statt xlR1C1 als Referencestyle
pvTab.SourceData = "'" & .Name & "'!" & .Range(.Cells(1, 2), _
.Cells(.Rows.Count, 2).End(xlUp).Offset(0, 11)).Address(ReferenceStyle:=xlR1C1)
End If
pvTab.RefreshTable
Next
End With
'für jeden Kunden mit "x" in der Kundenliste die Pivottabellenberichte im _
Blatt "Grafiken Lieferanten"  aktualisieren und drucken
'Pivotbericht(e) zu Kunden-Nr. aktualisieren
For Each rngKundenNr In rngKunden.Cells
If UCase(rngKundenNr.Offset(0, 2).Value) = "X" Then
'Prüfen, ob Kundennummer in Blatt Daten vorhanden
With Worksheets("Daten")
varCheck = Application.Match(rngKundenNr.Value, .Columns(3), 0)
End With
If IsError(varCheck) Then
MsgBox "Zu Kunden-Nr. " & rngKundenNr & " - " & rngKundenNr.Offset(0, 1) & vbLf _
& "gibt es keine Daten!", vbOKOnly, "Drucken Diagramme"
Else
'Pivotbericht(e) zu Kunden-Nr. aktualisieren
For Each pvTab In wksPivot.PivotTables
Set pvField = pvTab.PageFields("Kunden Nr.")
'pvField.CurrentPage = CStr(objCollection.Item(intKunde))
pvField.CurrentPage = rngKundenNr.Value
pvTab.RefreshTable
Next pvTab
Application.ScreenUpdating = True
'Ausgabe auf aktivem Drucker
wksPivot.PrintOut preview:=True 'für Produktionsbetrieb auf False setzen
End If
'Testzeile - später löschen/auskommentieren
If MsgBox("Nächstes Diagramm drucken?", vbQuestion + vbOKCancel, _
"Test-Anzeige - Diagramme drucken") = vbCancel Then Exit For
End If
Next rngKundenNr
MsgBox "Diagramme gedruckt auf " & strPrinter, vbOKOnly, "Fertig"
Fehler:
With Err
Select Case .Number
Case 0 'alles ok
Case Else
MsgBox "Fehler-Nr.: " & .Number & vbLf & .Description, _
vbInformation + vbOKOnly, "Makro: Drucken_KundenDiagramme"
End Select
End With
Application.ScreenUpdating = True
'Variablen aufräumen
Set wksPivot = Nothing
Set pvTab = Nothing: Set pvField = Nothing
Set rngKunden = Nothing: Set rngKundenNr = Nothing
End Sub

Anzeige
AW: Makrocode: Filter abfragen und drucken
22.08.2013 13:48:29
Hendrik
Hallo Franz,
da ich in der Druckliste jetzt doch bereits in Zeile 2 die erste Kundennummer stehen habe,
habe ich den Code hier angepasst:
With ActiveWorkbook.Worksheets("Druckliste")
'Bereich mit Kunden-Nummern der Objektvariblen zuweisen
Set rngKunden = .Range(.Cells(2, 1), .Cells(.Rows.Count, 1).End(xlUp))
End With
Ist das richtig?ODer müsste noch mehr angepasst werden?
Was hat es denn mit den Spalten B bis M auf sich?Da Blicke ich als VBA-Neuling noch nicht so ganz durch.
Mir wird ein Fehler angezeigt (Fehler Nr. 9), dass der Index außerhalb des Bereiches liegt.
Für mich ist das derzeit noch eine Nummer zu groß um da durchzublicken. Ich hoffe, du kannst mir nochmal helfen.
Grüße
Hendrik

Anzeige
AW: Makrocode: Filter abfragen und drucken
22.08.2013 14:52:36
fcs
Hallo Hendrik,
die Zeilenanpassung für die Druckliste ist in Ordnung.
Spalten B bis M:
wie schon erwähnt kam es beim Testen zu verschiedenen Phänomenen.
Und zwar dann, wenn eine Kunden-Nummer in der Datenquelle fehlte oder wenn Daten in der Datentabelle und/oder der Kundenliste ergänzt werden, aber die Datenquelle des Pivotberichts oder der Pivotbericht nicht aktualisert werden, bevor die Kundennummern für die Ausgabe der Diagramme vom Makro geändert werden. Deshalb hab ich die Aktualisierung der Pivotberichte zusätzlich eingefügt. Falls die Pivottabellen unterschiedliche Datenquellen haben, dann muss man hier auch noch was anpassen.
Fehler 9: Wahrscheinscheinlich stimmt ein Blattname im Code nicht (hier z.B. "Daten").
In der Beispieltabelle war ein Pivotbericht mit Daten aus Blatt "Daten" als Quelle.
Mache mal die Zeile "On Error GoTo Fehler" zu einem Kommentar und starte das Makro, dann stoppt das Makro in der Fehlerzeile und nach Klick auf Debug man kann weiter forschen.
Gruß
Franz
Da die grundsätzlichen Sachen geklärt sind, kannst du mir auch deine komplette Datei -ggf. anonymisiert- an die E-Mail-Addresse unter meinem Profil zuschicken.

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige