Ok. This isn't pretty, but it would be so nice to get it to work.
I want to create powerpoint slides from all charts on an Excel sheet. Unfortunately, I don't have a grip on powerpoint objects and my attempts at figuring it out have led to the following. This piece of code gives me an "automation error" and crasches powerpoint 9/10 times. It hangs at different places (there's probably a handful of fatal errors in here), but I'm pretty sure it's got to do with messing up the object structure.
[VBA]Option Explicit
Sub CreatePowerPointGeneral()
Dim activeSlide, duplicateSlide As PowerPoint.Slide
Dim cht As Excel.ChartObject
Dim NumberOfCharts, i As Integer
Dim objPPT As Object
Set objPPT = CreateObject("PowerPoint.Application")
objPPT.Visible = True
'Path to template:
objPPT.Presentations.Open "H:\MAKRON\Powerpoint Mall General.pptx"
objPPT.ActiveWindow.ViewType = 1
'How many charts do we have?
NumberOfCharts = ActiveSheet.ChartObjects.Count
If NumberOfCharts = 0 Then
MsgBox ("There are no charts!")
Exit Sub
End If
For i = NumberOfCharts To 1 Step -1
'Duplicate first slide
Set duplicateSlide = objPPT.ActivePresentation.Slides(1).Duplicate(1)
'Go to second slide
Set activeSlide = objPPT.ActivePresentation.Slides(2)
'Copy chart
ActiveSheet.ChartObjects(i).Activate
ActiveChart.ChartArea.Copy
'Don't know what this line does
objPPT.ActiveWindow.View.GotoSlide Index:=objPPT.Presentations(1).Slides(2).SlideIndex
objPPT.ActivePresentation.Slides(2).Shapes.Placeholders(2).Select
'Paste chart
objPPT.ActiveWindow.View.Paste
'Replace some text
Dim Question, tmp, pos1, pos2, row As String
Dim rownr As Integer
'Pick out source data for chart, and find the text directly above
tmp = ActiveChart.SeriesCollection(1).Formula
pos1 = InStr(tmp, "$B$")
pos2 = InStr(tmp, ":")
row = Right(Left(tmp, pos2 - 1), pos2 - pos1 - 3)
rownr = CInt(row) - 1
Question = ActiveSheet.Range("B" & rownr).Formula
'Paste this text into slide
Dim s, t As TextRange
Set t = objPPT.ActivePresentation.Slides(2).Shapes(2).TextFrame.TextRange.Replace(F indWhat:="Question", Replacewhat:=Question, WholeWords:=True)
Next
'The end
AppActivate ("Microsoft PowerPoint")
End Sub[/VBA]