Herbers Excel-Forum - das Archiv

Bewerten Sie hier bitte das Excel-Portal

Hilfe bei Diagramm zu PowerPoint VBA

Bild


Betrifft: Hilfe bei Diagramm zu PowerPoint VBA
von: Jochen

Geschrieben am: 11.09.2019 11:32:40
Guten Tag,
ich möchte mit folgendem VBA-Code meine Pivot-Filter durchgehen und nacheinander eine Powerpoint damit füllen. Pro Folie, ein Diagramm. Alles klappt so weit auch, jedoch speichert Powerpoint nur immer das letzte Diagramm ab. Ich öffne die Datei und nur die letzte Folie hat Inhalt. Kann mir jemand bei der Anpassung des Codes helfen?
Option Explicit
Sub Workbook_Open()
Dim Zelle As Range
Dim Wb As Workbook: Set Wb = ThisWorkbook
Dim Ws As Worksheet: Set Ws = Wb.Worksheets("PivotHaendlerMonat")
Dim p As PivotTable: Set p = Ws.PivotTables("PivotHaendlerMonat")
Dim f As PivotField: Set f = p.PivotFields("KDName")
Dim i As PivotItem, s
Dim j
GoTo Test
'Tabelle Aktualisieren
Selection.ListObject.QueryTable.Refresh BackgroundQuery:=False
'NULL Werte bei Spalten US bis AA suchen und durch 0 ersetzen
For Each Zelle In Range("K2:O" & Cells(Rows.Count, "O").End(xlUp).Row)
If Trim(Zelle.Value) = "" Then Zelle.Value = "0"
Next
'Alle Pivot-Tabellen aktualisieren
ActiveSheet.PivotTables("PivotLaender").PivotCache.Refresh
ActiveSheet.PivotTables("PivotLaenderRequest").PivotCache.Refresh
ActiveSheet.PivotTables("PivotHaendler").PivotCache.Refresh
ActiveSheet.PivotTables("PivotHaendlerRequest").PivotCache.Refresh
ActiveSheet.PivotTables("PivotHaendlerMonat").PivotCache.Refresh
ActiveSheet.PivotTables("PivotHaendlerRequestMonat").PivotCache.Refresh
Test:
s = Array("Deutschland", "England", "Schweden", "Frankreich", "Polen")
j = 0
For j = 0 To 4
'MsgBox s(j)
'Filter durchgehen
With f
For Each i In .PivotItems
If i.Name <> s(j) Then
i.Visible = False
Else:
i.Visible = True
End If
Next
End With
'Diagrammtitel anpassen
With ThisWorkbook.Worksheets("Haendler Grafiken Monat")
.ChartObjects(1).Chart.HasTitle = True
.ChartObjects(1).Chart.ChartTitle.Text = s(j)
End With
Dim strName As String
Dim strNameNeu As String
Dim strPfad As String
Dim strPfadNeu As String
Dim pptApp As Object
Dim pptPres As Presentation
Dim pptVorlage
Dim objShape As Object
'Speicherpfad der zu ändernden Datei
strPfad = "C:\Users\...."
strName = "...."
Set pptApp = New PowerPoint.Application
pptVorlage = strPfad & strName
pptApp.Presentations.Open Filename:=pptVorlage, untitled:=msoTrue
Set pptPres = pptApp.ActivePresentation
'Diagramm in Excel suchen und kopieren
Sheets("Haendler Grafiken Monat").ChartObjects("Diagramm 1").CopyPicture
'Diagramm in PowerPoint einfügen und Folie, Position und Größe bestimmen
Set objShape = pptPres.Slides(3 + j).Shapes.PasteSpecial(DataType:=ppPasteEnhancedMetafile)
With objShape
.LockAspectRatio = msoFalse
.Top = 85
.Height = 285
.Width = 664
.Left = 28
End With
Set objShape = Nothing
'Neuen Speichername & Ort festlegen
strPfadNeu = "C:\Users\..."
strNameNeu = "..."
pptPres.SaveAs strPfadNeu & strNameNeu
'Powerpoint sofort schließen
pptPres.Close
pptApp.Quit
Set pptPres = Nothing
Set pptApp = Nothing
'Pivot-Filter wieder resetten
ActiveWorkbook.SlicerCaches("Datenschnitt_KDName1").ClearManualFilter
Next j
End Sub

Bild

Betrifft: AW: Idee
von: 1712435.html
Geschrieben am: 11.09.2019 11:43:37
Hallo,
nach kurzem Lesen ist mein Eindruck:
Für jeden Pivot-Filter wird eine neue PPT-Vorlage geöffnet und gespeichert.
Vorschlag:
Am Anfang ein neues PPTX aus der Vorlage öffnen und für jeden Pivot-filter ein PPT.Slides.Add einfügen.
mfg
(ein Test ist mir zu aufwändig)

Bild

Betrifft: AW: Idee
von: 1712495.html
Geschrieben am: 11.09.2019 16:13:48
Erst einmal danke für die schnelle Antwort. Kannst du mir sagen welche Zeile ich hierzu ändern muss?
Hätte jetzt diese Zeile abgeändert:
Set objShape = pptPres.Slides(3 + j).Shapes.PasteSpecial(DataType:=ppPasteEnhancedMetafile)
Aber dabei zeigt mir der Editor immer einen Fehler an.

Bild

Betrifft: AW: Idee
von: 1712561.html

Geschrieben am: 11.09.2019 21:18:53
Him
ohne es getestet zu haben (dafür bräuchte manb die Dateien), versuchs mal so: 
Option Explicit
Sub Workbook_Open()
Dim Zelle As Range
Dim Wb As Workbook: Set Wb = ThisWorkbook
Dim Ws As Worksheet: Set Ws = Wb.Worksheets("PivotHaendlerMonat")
Dim p As PivotTable: Set p = Ws.PivotTables("PivotHaendlerMonat")
Dim f As PivotField: Set f = p.PivotFields("KDName")
Dim i As PivotItem, s
Dim j As Long
Dim strName As String
Dim strNameNeu As String
Dim strPfad As String
Dim strPfadNeu As String
Dim pptApp As Object
Dim pptPres As Presentation
Dim pptVorlage
Dim objShape As Object
GoTo Test
'Tabelle Aktualisieren
Selection.ListObject.QueryTable.Refresh BackgroundQuery:=False
'NULL Werte bei Spalten US bis AA suchen und durch 0 ersetzen
For Each Zelle In Range("K2:O" & Cells(Rows.Count, "O").End(xlUp).Row)
If Trim(Zelle.Value) = "" Then Zelle.Value = "0"
Next
'Alle Pivot-Tabellen aktualisieren
ActiveSheet.PivotTables("PivotLaender").PivotCache.Refresh
ActiveSheet.PivotTables("PivotLaenderRequest").PivotCache.Refresh
ActiveSheet.PivotTables("PivotHaendler").PivotCache.Refresh
ActiveSheet.PivotTables("PivotHaendlerRequest").PivotCache.Refresh
ActiveSheet.PivotTables("PivotHaendlerMonat").PivotCache.Refresh
ActiveSheet.PivotTables("PivotHaendlerRequestMonat").PivotCache.Refresh
Test:
s = Array("Deutschland", "England", "Schweden", "Frankreich", "Polen")
j = 0
'Speicherpfad der zu ändernden Datei
strPfad = "C:\Users\...."
strName = "...."
Set pptApp = New PowerPoint.Application
pptVorlage = strPfad & strName
pptApp.Presentations.Open FileName:=pptVorlage, untitled:=msoTrue
Set pptPres = pptApp.ActivePresentation
For j = 0 To 4
'MsgBox s(j)
'Filter durchgehen
With f
For Each i In .PivotItems
If i.Name <> s(j) Then
i.Visible = False
Else:
i.Visible = True
End If
Next
End With
'Diagrammtitel anpassen
With ThisWorkbook.Worksheets("Haendler Grafiken Monat")
.ChartObjects(1).Chart.HasTitle = True
.ChartObjects(1).Chart.ChartTitle.Text = s(j)
End With
'Diagramm in Excel suchen und kopieren
Sheets("Haendler Grafiken Monat").ChartObjects("Diagramm 1").CopyPicture
'Diagramm in PowerPoint einfügen und Folie, Position und Größe bestimmen
Set objShape = pptPres.Slides(3 + j).Shapes.PasteSpecial(DataType:=ppPasteEnhancedMetafile) _
With objShape
.LockAspectRatio = msoFalse
.Top = 85
.Height = 285
.Width = 664
.Left = 28
End With
Set objShape = Nothing
Set pptPres = Nothing
Set pptApp = Nothing
'Pivot-Filter wieder resetten
ActiveWorkbook.SlicerCaches("Datenschnitt_KDName1").ClearManualFilter
pptPres.Slides.AddSlide
Next j
'letzte leere Folie löschen
pptPres.Slides(8).delete
'Neuen Speichername & Ort festlegen
strPfadNeu = "C:\Users\..."
strNameNeu = "..."
pptPres.SaveAs strPfadNeu & strNameNeu
'Powerpoint sofort schließen
pptPres.Close
pptApp.Quit
End Sub
Das Anlegen und das Speichern der neuen Präsentation gehört nicht in die For i-Schleife. Dafür muss in der Schleife eine neue Folie angelegt werden. Dann landet das erste Diagramm auf Folie 4 und die weitere dahinter.
Bild

Betrifft: AW: Idee
von: 1712656.html
Geschrieben am: 12.09.2019 11:31:14
Hallo Regina,
ich bekomme immer eine Fehlermeldung: "Fehler beim Kompilieren: Argument ist nicht optional"
Und .AddSlide ist dabei markiert.
Zeile:
pptPres.Slides.AddSlide

Bild

Betrifft: AW: Idee
von: 1712660.html

Geschrieben am: 12.09.2019 12:08:39
Hi,
bin selbst nicht allzu tief in PowerPoint VBA drin, bei der AddSlides-Methode muss noch angegeben werden, an welcher Stelle und mit welchem Layout das Slide eingefügt werden soll. Lies mal hier nach:
https://docs.microsoft.com/de-de/office/vba/api/powerpoint.slides.addslide
Außerdem könntest Du die Frage noch in einem Pp-Forum stellen:
https://www.ms-office-forum.net/forum/forumdisplay.php?f=31
Gruß Regina
Bild

Betrifft: AW: Beispiel Slides.Add
von: 1712810.html
Geschrieben am: 13.09.2019 09:09:29
Hallo,
hier ein Beispiel einen neuen slide mit einem bestimmten Layout anzulegen:


Set Layout = ActivePresentation.SlideMaster.CustomLayouts.Add(7) 'Folienlayout auswählen
Set NeueFolie = ActivePresentation.Slides.AddSlide(i, Layout) 'Neue Folie mit ausgewähltem  _
Layout
Seitdem es in PP keinen Makro-Rekorder mehr gibt, ist es recht mühsam einen VBA-Code zu entwickeln.
Eine sehr gute Quelle zum Lernen ist Case:
http://vbanet.blogspot.com/
und nach "PowerPoint" suchen.
mfg
Excel-Beispiele zum Thema "Hilfe bei Diagramm zu PowerPoint VBA"
Diagramm in Userform Export von Diagrammen im Grafikformat
Diagramm aus Arbeitsblatt in Diagrammblatt übertragen Balkendiagramm simulieren
Diagramm aus Daten einer Bandbreite bilden Diagramm-Datenreihen blinken lassen und Linie langsam zeichnen
Diagramm exportieren und in Tabellenblatt importieren Eine Serie von Diagrammen erstellen und Druckansicht zeigen
Diagramm-Datenbereich über Schaltfläche festlegen Mit einer Diagramm-Bildlaufleiste durch Tabelle bewegen
Bewerten Sie hier bitte das Excel-Portal