15.02.2023, 14:01
Guten Mittag,
ich würde gerne folgendes machen aber scheitere gnadenlos:-D. Ich würde gerne Diagramme aus Excel in eine PowerPoint kopieren. Der unten stehende Code klappt zwar aber nicht wie ich mir das vorstelle.
Das was ich tun möchte ist folgendermaßen:
- Ich würde gerne eine Vorlage von meinem Desktop öffnen
- Dann würde ich gerne Diagramme in meinem Excel ansprechen (die Diagramme sind teilweise auf unterschiedlichen Blättern)
- Die Diagramme würde ich dann gerne kopieren und auf einer Folienseite nach meiner Wahl in die richtige Position einfügen
- Den Titel der Folien würde ich gerne aus einer Zelle in einem Tabellenblatt in die PPT-Überschrift nehmen
Hat jemand eine Idee wie ich den Code verändern muss oder wie ich das hinbekomme?
Viele Grüße
Jonas
Sub ChartObjectsNachPowerpoint()
Dim pptApp As Object, pptPres As Object
Dim chtObj As Object, shp As Object, i
Set pptApp = CreateObject("PowerPoint.Application")
Set pptPres = pptApp.Presentations.Add(msoTrue)
For Each chtObj In ActiveSheet.ChartObjects
chtObj.Chart.ChartArea.Copy
i = i + 1
Set pptSlide = pptPres.Slides.Add(i, 12) '12 = ppLayoutBlank
Set shp = pptSlide.Shapes.Paste
shp.Top = 0
shp.Left = 0
shp.Width = 400
shp.Height = 400
Next
pptApp.Visible = True
End Sub
ich würde gerne folgendes machen aber scheitere gnadenlos:-D. Ich würde gerne Diagramme aus Excel in eine PowerPoint kopieren. Der unten stehende Code klappt zwar aber nicht wie ich mir das vorstelle.
Das was ich tun möchte ist folgendermaßen:
- Ich würde gerne eine Vorlage von meinem Desktop öffnen
- Dann würde ich gerne Diagramme in meinem Excel ansprechen (die Diagramme sind teilweise auf unterschiedlichen Blättern)
- Die Diagramme würde ich dann gerne kopieren und auf einer Folienseite nach meiner Wahl in die richtige Position einfügen
- Den Titel der Folien würde ich gerne aus einer Zelle in einem Tabellenblatt in die PPT-Überschrift nehmen
Hat jemand eine Idee wie ich den Code verändern muss oder wie ich das hinbekomme?
Viele Grüße
Jonas
Sub ChartObjectsNachPowerpoint()
Dim pptApp As Object, pptPres As Object
Dim chtObj As Object, shp As Object, i
Set pptApp = CreateObject("PowerPoint.Application")
Set pptPres = pptApp.Presentations.Add(msoTrue)
For Each chtObj In ActiveSheet.ChartObjects
chtObj.Chart.ChartArea.Copy
i = i + 1
Set pptSlide = pptPres.Slides.Add(i, 12) '12 = ppLayoutBlank
Set shp = pptSlide.Shapes.Paste
shp.Top = 0
shp.Left = 0
shp.Width = 400
shp.Height = 400
Next
pptApp.Visible = True
End Sub