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 Namen, der zweite das Quartal und der dritte welcher ort ist.
Links oben kommt das erste und zweite Quartal gesamt hin von einer der Personen. Oben in der Mitte nur das erste Quartal von der einen Person. rechts oben wäre dann Quartal 2 von der genannten Person.
Mittig links sind dann von einer anderen Person die beiden Quartale. In der mitte nur das erste Quartal, usw..Ich muss das für 3 verschiedene orte machen und das jede Woche..ein Makro würde Abhilfe schaffen!
Gibt es eine Möglichkeit das in einer schleife oder ähnliches zu machen? bin mit meinem Latein am ende. Ich schaffe es leider auch nicht meine Dokumente hier anzuhängen, wenn jmd weiß wie es geht würde ich es auch hochladen.
Zum Verständnis habe ich meinen Code angefügt:
Sub owntry()
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 der PPT Vorlage")
Set PPTPres = PPTPres.activepresentation
ActiveWorkbook.SlicerCaches("Datenschnitt_Consultant").ClearManualFilter
With ActiveWorkbook.SlicerCaches("Datenschnitt_Consultant")
.SlicerItems("Lotti").Selected = False
.SlicerItems("jens").Selected = True
.SlicerItems("Thomas ").Selected = False
.SlicerItems("Jens ").Selected = False
.SlicerItems("Paul").Selected = False
End With
ActiveWorkbook.SlicerCaches("Datenschnitt_Quartal").ClearManualFilter
With ActiveWorkbook.SlicerCaches("Datenschnitt_Quartal")
.SlicerItems("Q1").Selected = True
.SlicerItems("Q2").Selected = True
.SlicerItems("Q3").Selected = False
.SlicerItems("Q4").Selected = False
.SlicerItems("(Leer)").Selected = False
End With
Sheets("Tabelle2").ChartObjects("Diagramm 5").Activate
ActiveChart.ChartArea.Select
ActiveChart.ChartArea.Copy
Sheets("Tabelle2").ChartObjects("Diagramm 5").CopyPicture
Set objShape = PPTPres.Slides(3).shapes.PasteSpecial(DataType:=ppPasteEnhancedMetafile)
With objShape
.Top = 68
.height = 5
.width = 180
.Left = 40
End With
ActiveWorkbook.SlicerCaches("Datenschnitt_Consultant").ClearManualFilter
With ActiveWorkbook.SlicerCaches("Datenschnitt_Consultant")
.SlicerItems("Lotti").Selected = False
.SlicerItems("jens").Selected = True
.SlicerItems("Thomas ").Selected = False
.SlicerItems("Jens ").Selected = False
.SlicerItems("Paul").Selected = False
End With
ActiveWorkbook.SlicerCaches("Datenschnitt_Quartal").ClearManualFilter
With ActiveWorkbook.SlicerCaches("Datenschnitt_Quartal")
.SlicerItems("Q1").Selected = True
.SlicerItems("Q2").Selected = False
.SlicerItems("Q3").Selected = False
.SlicerItems("Q4").Selected = False
.SlicerItems("(Leer)").Selected = False
End With
Sheets("Tabelle2").ChartObjects("Diagramm 5").Activate
ActiveChart.ChartArea.Select
ActiveChart.ChartArea.Copy
Sheets("Tabelle2").ChartObjects("Diagramm 5").CopyPicture
Set objShape = PPTPres.Slides(3).shapes.PasteSpecial(DataType:=ppPasteEnhancedMetafile)
With objShape
.Top = 68
.height = 5
.width = 180
.Left = 257
End With
ActiveWorkbook.SlicerCaches("Datenschnitt_Consultant").ClearManualFilter
With ActiveWorkbook.SlicerCaches("Datenschnitt_Consultant")
.SlicerItems("Lotti").Selected = False
.SlicerItems("jens").Selected = True
.SlicerItems("Thomas ").Selected = False
.SlicerItems("Jens ").Selected = False
.SlicerItems("Paul").Selected = False
End With
ActiveWorkbook.SlicerCaches("Datenschnitt_Quartal").ClearManualFilter
With ActiveWorkbook.SlicerCaches("Datenschnitt_Quartal")
.SlicerItems("Q1").Selected = False
.SlicerItems("Q2").Selected = True
.SlicerItems("Q3").Selected = False
.SlicerItems("Q4").Selected = False
.SlicerItems("(Leer)").Selected = False
End With
Sheets("Tabelle2").ChartObjects("Diagramm 5").Activate
ActiveChart.ChartArea.Select
ActiveChart.ChartArea.Copy
Sheets("Tabelle2").ChartObjects("Diagramm 5").CopyPicture
Set objShape = PPTPres.Slides(3).shapes.PasteSpecial(DataType:=ppPasteEnhancedMetafile)
With objShape
.Top = 68
.height = 5
.width = 180
.Left = 475
End With
ActiveWorkbook.SlicerCaches("Datenschnitt_Consultant").ClearManualFilter
With ActiveWorkbook.SlicerCaches("Datenschnitt_Consultant")
.SlicerItems("Lotti").Selected = True
.SlicerItems("jens").Selected = False
.SlicerItems("Thomas ").Selected = False
.SlicerItems("Jens ").Selected = False
.SlicerItems("Paul").Selected = False
End With
ActiveWorkbook.SlicerCaches("Datenschnitt_Quartal").ClearManualFilter
With ActiveWorkbook.SlicerCaches("Datenschnitt_Quartal")
.SlicerItems("Q1").Selected = True
.SlicerItems("Q2").Selected = True
.SlicerItems("Q3").Selected = False
.SlicerItems("Q4").Selected = False
.SlicerItems("(Leer)").Selected = False
End With
Sheets("Tabelle2").ChartObjects("Diagramm 5").Activate
ActiveChart.ChartArea.Select
ActiveChart.ChartArea.Copy
Sheets("Tabelle2").ChartObjects("Diagramm 5").CopyPicture
Set objShape = PPTPres.Slides(3).shapes.PasteSpecial(DataType:=ppPasteEnhancedMetafile)
With objShape
.Top = 170
.height = 5
.width = 180
.Left = 40
End With
ActiveWorkbook.SlicerCaches("Datenschnitt_Consultant").ClearManualFilter
With ActiveWorkbook.SlicerCaches("Datenschnitt_Consultant")
.SlicerItems("Lotti").Selected = True
.SlicerItems("jens").Selected = False
.SlicerItems("Thomas ").Selected = False
.SlicerItems("Jens ").Selected = False
.SlicerItems("Paul").Selected = False
End With
ActiveWorkbook.SlicerCaches("Datenschnitt_Quartal").ClearManualFilter
With ActiveWorkbook.SlicerCaches("Datenschnitt_Quartal")
.SlicerItems("Q1").Selected = True
.SlicerItems("Q2").Selected = False
.SlicerItems("Q3").Selected = False
.SlicerItems("Q4").Selected = False
.SlicerItems("(Leer)").Selected = False
End With
Sheets("Tabelle2").ChartObjects("Diagramm 5").Activate
ActiveChart.ChartArea.Select
ActiveChart.ChartArea.Copy
Sheets("Tabelle2").ChartObjects("Diagramm 5").CopyPicture
Set objShape = PPTPres.Slides(3).shapes.PasteSpecial(DataType:=ppPasteEnhancedMetafile)
With objShape
.Top = 170
.height = 5
.width = 180
.Left = 257
End With
ActiveWorkbook.SlicerCaches("Datenschnitt_Consultant").ClearManualFilter
With ActiveWorkbook.SlicerCaches("Datenschnitt_Consultant")
.SlicerItems("Lotti").Selected = True
.SlicerItems("jens").Selected = False
.SlicerItems("Thomas ").Selected = False
.SlicerItems("Jens ").Selected = False
.SlicerItems("Paul").Selected = False
End With
ActiveWorkbook.SlicerCaches("Datenschnitt_Quartal").ClearManualFilter
With ActiveWorkbook.SlicerCaches("Datenschnitt_Quartal")
.SlicerItems("Q1").Selected = False
.SlicerItems("Q2").Selected = True
.SlicerItems("Q3").Selected = False
.SlicerItems("Q4").Selected = False
.SlicerItems("(Leer)").Selected = False
End With
Sheets("Tabelle2").ChartObjects("Diagramm 5").Activate
ActiveChart.ChartArea.Select
ActiveChart.ChartArea.Copy
Sheets("Tabelle2").ChartObjects("Diagramm 5").CopyPicture
Set objShape = PPTPres.Slides(3).shapes.PasteSpecial(DataType:=ppPasteEnhancedMetafile)
With objShape
.Top = 170
.height = 5
.width = 180
.Left = 475
End With
ActiveWorkbook.SlicerCaches("Datenschnitt_Consultant").ClearManualFilter
With ActiveWorkbook.SlicerCaches("Datenschnitt_Consultant")
.SlicerItems("Lotti").Selected = False
.SlicerItems("jens").Selected = False
.SlicerItems("Thomas ").Selected = True
.SlicerItems("Jens ").Selected = False
.SlicerItems("Paul").Selected = False
End With
ActiveWorkbook.SlicerCaches("Datenschnitt_Quartal").ClearManualFilter
With ActiveWorkbook.SlicerCaches("Datenschnitt_Quartal")
.SlicerItems("Q1").Selected = True
.SlicerItems("Q2").Selected = True
.SlicerItems("Q3").Selected = False
.SlicerItems("Q4").Selected = False
.SlicerItems("(Leer)").Selected = False
End With
Sheets("Tabelle2").ChartObjects("Diagramm 5").Activate
ActiveChart.ChartArea.Select
ActiveChart.ChartArea.Copy
Sheets("Tabelle2").ChartObjects("Diagramm 5").CopyPicture
Set objShape = PPTPres.Slides(3).shapes.PasteSpecial(DataType:=ppPasteEnhancedMetafile)
With objShape
.Top = 272
.height = 5
.width = 180
.Left = 40
End With
With ActiveWorkbook.SlicerCaches("Datenschnitt_Consultant")
.SlicerItems("Lotti").Selected = False
.SlicerItems("jens").Selected = False
.SlicerItems("Thomas ").Selected = True
.SlicerItems("Jens ").Selected = False
.SlicerItems("Paul").Selected = False
End With
ActiveWorkbook.SlicerCaches("Datenschnitt_Quartal").ClearManualFilter
With ActiveWorkbook.SlicerCaches("Datenschnitt_Quartal")
.SlicerItems("Q1").Selected = True
.SlicerItems("Q2").Selected = False
.SlicerItems("Q3").Selected = False
.SlicerItems("Q4").Selected = False
.SlicerItems("(Leer)").Selected = False
End With
Sheets("Tabelle2").ChartObjects("Diagramm 5").Activate
ActiveChart.ChartArea.Select
ActiveChart.ChartArea.Copy
Sheets("Tabelle2").ChartObjects("Diagramm 5").CopyPicture
Set objShape = PPTPres.Slides(3).shapes.PasteSpecial(DataType:=ppPasteEnhancedMetafile)
With objShape
.Top = 272
.height = 5
.width = 180
.Left = 257
End With
With ActiveWorkbook.SlicerCaches("Datenschnitt_Consultant")
.SlicerItems("Lotti").Selected = False
.SlicerItems("jens").Selected = False
.SlicerItems("Thomas ").Selected = True
.SlicerItems("Jens ").Selected = False
.SlicerItems("Paul").Selected = False
End With
ActiveWorkbook.SlicerCaches("Datenschnitt_Quartal").ClearManualFilter
With ActiveWorkbook.SlicerCaches("Datenschnitt_Quartal")
.SlicerItems("Q1").Selected = False
.SlicerItems("Q2").Selected = True
.SlicerItems("Q3").Selected = False
.SlicerItems("Q4").Selected = False
.SlicerItems("(Leer)").Selected = False
End With
Sheets("Tabelle2").ChartObjects("Diagramm 5").Activate
ActiveChart.ChartArea.Select
ActiveChart.ChartArea.Copy
Sheets("Tabelle2").ChartObjects("Diagramm 5").CopyPicture
Set objShape = PPTPres.Slides(3).shapes.PasteSpecial(DataType:=ppPasteEnhancedMetafile)
With objShape
.Top = 272
.height = 5
.width = 180
.Left = 475
End With
End Subch
Vielen dank!
|