Live-Forum - Die aktuellen Beiträge
Datum
Titel
28.03.2024 21:12:36
28.03.2024 18:31:49
Anzeige
Archiv - Navigation
1388to1392
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

Pivotchart drucken

Pivotchart drucken
28.10.2014 12:11:58
f.sonneborn
Hallo zusammen,
ich habe ein Pivotchart, mit dem ich die Umsatzentwicklung unserer Kunden darstellen kann.
Nun möchte ich dieses Diagramm gerne ausdrucken. Für den aktuell ausgewählten Kunden ist das ja auch kein Thema, wenn ich aber jetzt für jeden Kunden (ca. 450 Stück) ein Diagramm an den Drucker senden will, möchte ich nicht jeden einzeln auswählen müssen.
Gibt es für so etwas einen Automatismus?
Also auf Klick -- Erstellen eines Diagramms für jeden einzelnen Kunden.
Hoffe, ich hab mich verständlich ausgedrückt.
Solltet Ihr weitere Infos benötigen, bitte kurze Rückmeldung.
Danke für eure Hilfe!
-Florian

1
Beitrag zum Forumthread
Beitrag zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Pivotchart drucken
29.10.2014 11:03:39
fcs
Hallo Florian,
eine Automatismus als Funktion in Excel gibt es nicht.
Die Vorgabe des Kundennamens im Berichtsfeld oder als Filter für das Zeilenfeld und das Drucken muss man mit einem maßgeschneiderten Makro steuern.
Nachfolgend 2 Makrobeispiele. Das passend musst du im VBA-Editor in ein allgemeines Modul der Datei mit dem Pivotbericht/Diagramm kopieren oder in deine persönliche Makro-Arbeitsmappe.
Die Namen von Blättern (Tabellen, Diagramm) und Pivotfeld musst du ggf. anpassen.
Gruß
Franz
'Erstellt unter Excel 2010
'vor dem Starten des Makros den Ausgabedrucker wählen!!!
Sub KundenDiagramme_Drucken_Berichtsfeld()
'Das Feld Kunde ist im Pivotbericht als Berichtsfeld eingerichtet
Dim wksPivot As Worksheet
Dim objChart As Chart
Dim pvTab As PivotTable, pvField As PivotField, pvItem As PivotItem
Dim intItem As Integer
Set wksPivot = ActiveWorkbook.Worksheets("Auswertung") 'Tabellenblatt mit Pivotbericht
Set pvTab = wksPivot.PivotTables(1)
Set pvField = pvTab.PageFields("Kunde")
Set objChart = wksPivot.ChartObjects(1).Chart 'wenn Diagramm in Tabellenblatt eingebettet
'  Set objChart = ActiveWorkbook.Charts("Diagramm") 'wenn Diagramm als separates Blatt angelegt
'Seitenname im Feld auf die einzelnen Kunden setzen und Diagramm drucken
For intItem = 1 To pvField.PivotItems.Count
Select Case pvField.PivotItems(intItem).Name
Case "(All)", "(Alle)"
'do nothing
Case Else
pvField.CurrentPage = pvField.PivotItems(intItem).Name
pvTab.RefreshTable 'evtl. nicht notwendig
objChart.PrintOut
'        objChart.PrintPreview
End Select
If intItem = 3 Then Exit For 'Notausgang zum Testen - Zeile löschen wenn alles funktioniert
Next
End Sub
Sub KundenDiagramme_Drucken_Zeilenfeld()
'Das Feld Kunde ist im Pivotbericht als Zeilenfeld eingerichtet
Dim wksPivot As Worksheet
Dim objChart As Chart
Dim pvTab As PivotTable, pvField As PivotField, pvItem As PivotItem
Dim intItem As Integer, arrItems() As String
Set wksPivot = ActiveWorkbook.Worksheets("Auswertung") 'Tabellenblatt mit Pivotbericht
Set pvTab = wksPivot.PivotTables(1)
Set pvField = pvTab.RowFields("Kunde")
Set objChart = wksPivot.ChartObjects(1).Chart 'wenn Diagramm in Tabellenblatt eingebettet
'  Set objChart = ActiveWorkbook.Charts("Diagramm") 'wenn Diagramm als separates Blatt angelegt
pvField.ClearAllFilters
ReDim arrItems(1 To pvField.PivotItems.Count)
'Alle Pivotitems in Array einlesen
For Each pvItem In pvField.PivotItems
If pvItem.Visible = True And pvItem.RecordCount > 0 Then
intItem = intItem + 1
ReDim Preserve arrItems(1 To intItem)
arrItems(intItem) = pvItem.Name
End If
Next
'Filter für Feld auf die einzelnen Kundennamen setzen und Diagramm drucken
For intItem = 1 To UBound(arrItems)
pvField.ClearAllFilters
Select Case arrItems(intItem)
Case "(All)", "(Alle)"
'do nothing
Case Else
pvField.PivotFilters.Add Type:=xlCaptionEquals, Value1:=arrItems(intItem)
pvTab.RefreshTable 'evtl. nicht notwendig
objChart.PrintOut
'        objChart.PrintPreview
End Select
If intItem = 3 Then Exit For 'Notausgang zum Testen - Zeile löschen wenn alles funktioniert
Next
End Sub

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige