Hallo zusammen,
Ich arbeite momentan an einem Projekt und komme leider nicht weiter.
Ich muss aus einem Excel Dokument ein Diagramm kopieren und in eine PPT Vorlage einfügen(siehe erste schritte).Das klappt auch hervorragend. Jetzt habe ich aber das Problem, dass es drei verschiedene Filter gibt. Der erste ist die Flugroute, der zweite der Monat und die dritte welcher Carrier geflogen ist. Auf seite drei der PPT kommt erstmal ganz links oben Monat 11 von beiden carriern einer strecke. Dann zentral daneben der 12.Monat und ganz rechts der 1. Monat. Am anfang sind auch beide carrier ausgewählt. in der zweiten reihe kommt dann der elfte Monat wieder ganz link von der ausgewählten strecke, jedoch nur mit einem der carriern. In der Mitte wieder die selbe strecke mit dem einen carrier aber der 12. Monat. Ganz rechts kommt dann Monat 1, slebe strecke und selber carrier.
Das muss für 5 Strecken gemacht werden mit jeweils 5 Monaten( 2. und 3. Monat kommen auf eine slide dahinter).
Ich habe es erst manuell versucht aber irgendwann war das makro zu lang und wollte nicht mehr.
Zum Verständnis habe ich meinen Code angefügt:
Sub test()
Dim PowerPointFile As PowerPoint.Presentation
Dim PPTPres As Object
Dim cht As Excel.ChartObject
Dim newPowerPoint As PowerPoint.Application
Dim Slides As PowerPoint.Slide
Dim activepresentation As PowerPoint.Presentation
Dim shapes As PowerPoint.Shape
Dim activeSlide As PowerPoint.Slide
Dim i As Integer
Dim height As Integer
Dim width As Integer
Dim xpos As Integer
Dim ypos As Integer
Grafik = ActiveWorkbook.Name
Set PPTPres = CreateObject("PowerPoint.application")
Set PowerPointFile = PPTPres.Presentations.Open("Pfad zu meiner Vorlage")
Set PPTPres = PPTPres.activepresentation
Set cht = ActiveSheet.ChartObjects("Diagramm 1")
ActiveWorkbook.SlicerCaches("Datenschnitt_Ctrl_Airl_Cd").ClearManualFilter
With ActiveWorkbook.SlicerCaches("Datenschnitt_Mapping_Route")
.SlicerItems("Ham-Bhg").Selected = False
.SlicerItems("Tro-Ham").Selected = False
.SlicerItems("Sqv-Ham").Selected = True
.SlicerItems("(Leer)").Selected = False
End With
ActiveWorkbook.SlicerCaches("Datenschnitt_Ctrl_Airl_Cd").SlicerItems("VS").Selected = True
ActiveWorkbook.SlicerCaches("Datenschnitt_Ctrl_Airl_Cd").SlicerItems("SK").Selected = True
ActiveWorkbook.SlicerCaches("Datenschnitt_Dep_Mon_for_Filter").SlicerItems("11").Selected = True
ActiveWorkbook.SlicerCaches("Datenschnitt_Dep_Mon_for_Filter").SlicerItems("1").Selected = False
ActiveWorkbook.SlicerCaches("Datenschnitt_Dep_Mon_for_Filter").SlicerItems("2").Selected = False
ActiveWorkbook.SlicerCaches("Datenschnitt_Dep_Mon_for_Filter").SlicerItems("3").Selected = False
ActiveWorkbook.SlicerCaches("Datenschnitt_Dep_Mon_for_Filter").SlicerItems("10").Selected = False
ActiveWorkbook.SlicerCaches("Datenschnitt_Dep_Mon_for_Filter").SlicerItems("12").Selected = False
Sheets("Pivot").ChartObjects("Diagramm 1").Activate
ActiveChart.ChartArea.Select
ActiveChart.ChartArea.Copy
Sheets("Pivot").ChartObjects("Diagramm 1").CopyPicture
Set objShape = PPTPres.Slides(3).shapes.PasteSpecial(DataType:=ppPasteEnhancedMetafile)
With objShape
.Top = 68
.height = 5
.width = 180
.Left = 40
End With
SO WÜRDE DIE Fortsetzung AUSSEHEN FÜR JEDES EINZELNE:
ActiveWorkbook.SlicerCaches("Datenschnitt_Ctrl_Airl_Cd").ClearManualFilter
With ActiveWorkbook.SlicerCaches("Datenschnitt_Mapping_Route")
.SlicerItems("route").Selected = False
.SlicerItems("Ham- Sto").Selected = False
.SlicerItems("Ham-Svq").Selected = True
.SlicerItems("(Leer)").Selected = False
End With
ActiveWorkbook.SlicerCaches("Datenschnitt_Ctrl_Airl_Cd").SlicerItems("SK").Selected = True
ActiveWorkbook.SlicerCaches("Datenschnitt_Ctrl_Airl_Cd").SlicerItems("JK").Selected = True
ActiveWorkbook.SlicerCaches("Datenschnitt_Dep_Mon_for_Filter").SlicerItems("11").Selected = False
ActiveWorkbook.SlicerCaches("Datenschnitt_Dep_Mon_for_Filter").SlicerItems("1").Selected = True
ActiveWorkbook.SlicerCaches("Datenschnitt_Dep_Mon_for_Filter").SlicerItems("2").Selected = False
ActiveWorkbook.SlicerCaches("Datenschnitt_Dep_Mon_for_Filter").SlicerItems("3").Selected = False
ActiveWorkbook.SlicerCaches("Datenschnitt_Dep_Mon_for_Filter").SlicerItems("10").Selected = False
ActiveWorkbook.SlicerCaches("Datenschnitt_Dep_Mon_for_Filter").SlicerItems("12").Selected = False
Sheets("Pivot").ChartObjects("Diagramm 1").CopyPicture
Set objShape = PPTPres.Slides(3).shapes.PasteSpecial(DataType:=ppPasteEnhancedMetafile)
With objShape
.Top = 68
.height = 5
.width = 180
.Left = 475
End With
Das geht natürlich noch seeeeehr lange weiter :(
Würde mich über eine Rückmeldung freuen!!
LG NIklas
|