hi liebe community,
ich wuerde sehr gerne aus einem ziemlich grossen Excel sheet eine PPT erzeugen lassen in der viele Diagramme drin sind.
Bsp:
Auf Sheet 2 habe ich 3 Diagramme, diese sollen schoen sortiert auf der PPT in einer Silde dargestellt werden.
Auf Sheet 3 habe ich 5 Diagramme, diese sollen auch schoen sortiert auf der PPT in einer Silde dargestellt werden.
Ich habe lange herumgesucht und habe dabei diesen code gefunden.
Sub ChartObjectsNachPowerpoint()
Dim pptApp As Object, pptPres As Object
Dim chtObj As Object, shp As Object, i, sl
Set pptApp = CreateObject("PowerPoint.Application")
pptApp.Visible = True
Set pptPres = pptApp.Presentations.Add(msoTrue)
'Set pptPres = pptApp.Presentations.Add(msoTrue) 'erzeugt neue .ppt
iter = 1
While iter <= Sheets.Count
Sheets(iter).Select
For Each chtObj In ActiveSheet.ChartObjects
chtObj.CopyPicture xlScreen, xlPicture
i = i + 1
If i Mod 2 = 0 Then
'Koordinaten fürs 2te shape des slide
Set shp = pptSlide.Shapes.Paste
shp.Top = 300
shp.Left = 300
shp.Height = 200
Else
sl = sl + 1
Set pptSlide = pptPres.Slides.Add(sl, 12) ' neues Blatt in ppt, 12 ist ohne Textfelder
Set shp = pptSlide.Shapes.Paste
shp.Top = 30
shp.Left = 30
shp.Height = 200
End If
'iter = iter + 1 das ist an dieser Stelle falsch und kann weg
Next
iter = iter + 1
Wend
pptApp.Visible = True
End Sub
Kann mir hier jemand helfen diesen zu modifizieren damit man die sildes so darstellen kann?
waere super dankbar
Danke schonmal im Vorraus.
Gruesse Christoph
ich wuerde sehr gerne aus einem ziemlich grossen Excel sheet eine PPT erzeugen lassen in der viele Diagramme drin sind.
Bsp:
Auf Sheet 2 habe ich 3 Diagramme, diese sollen schoen sortiert auf der PPT in einer Silde dargestellt werden.
Auf Sheet 3 habe ich 5 Diagramme, diese sollen auch schoen sortiert auf der PPT in einer Silde dargestellt werden.
Ich habe lange herumgesucht und habe dabei diesen code gefunden.
Sub ChartObjectsNachPowerpoint()
Dim pptApp As Object, pptPres As Object
Dim chtObj As Object, shp As Object, i, sl
Set pptApp = CreateObject("PowerPoint.Application")
pptApp.Visible = True
Set pptPres = pptApp.Presentations.Add(msoTrue)
'Set pptPres = pptApp.Presentations.Add(msoTrue) 'erzeugt neue .ppt
iter = 1
While iter <= Sheets.Count
Sheets(iter).Select
For Each chtObj In ActiveSheet.ChartObjects
chtObj.CopyPicture xlScreen, xlPicture
i = i + 1
If i Mod 2 = 0 Then
'Koordinaten fürs 2te shape des slide
Set shp = pptSlide.Shapes.Paste
shp.Top = 300
shp.Left = 300
shp.Height = 200
Else
sl = sl + 1
Set pptSlide = pptPres.Slides.Add(sl, 12) ' neues Blatt in ppt, 12 ist ohne Textfelder
Set shp = pptSlide.Shapes.Paste
shp.Top = 30
shp.Left = 30
shp.Height = 200
End If
'iter = iter + 1 das ist an dieser Stelle falsch und kann weg
Next
iter = iter + 1
Wend
pptApp.Visible = True
End Sub
Kann mir hier jemand helfen diesen zu modifizieren damit man die sildes so darstellen kann?
waere super dankbar
Danke schonmal im Vorraus.
Gruesse Christoph