Antworten und eine Beispielarbeitsmappe zu Fragen zum Thema "Diagramm" finden Sie hier: Hier klicken

Hilfe bei Diagramm zu PowerPoint VBA

Bewerten Sie hier bitte das Excel-Portal

Der kurze Weg zum Ziel: Auftragsprogrammierung

Informationen und Beispiele zum Thema MsgBox
Screenshot zu MsgBox	MsgBox-Seite mit Beispielarbeitsmappe aufrufen

Informationen und Beispiele zum Thema Userform
Screenshot zu Userform	Userform-Seite mit Beispielarbeitsmappe aufrufen

Hilfe bei Diagramm zu PowerPoint VBA

Hilfe bei Diagramm zu PowerPoint VBA von Jochen vom 11.09.2019 11:32:40

AW: Idee - von Fennek am 11.09.2019 11:43:37

AW: Idee - von Jochen am 11.09.2019 16:13:48

AW: Idee - von Regina Resch-Jansen am 11.09.2019 21:18:53

AW: Idee - von Jochen am 12.09.2019 11:31:14

AW: Idee - von Regina Resch-Jansen am 12.09.2019 12:08:39

AW: Beispiel Slides.Add - von Fennek am 13.09.2019 09:09:29

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

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)

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.

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.

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

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

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