Automation error when creating powerpoint slides from Excel charts

[aurora1827]

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.



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

[JonPeltier]

First, this:

Dim activeSlide, duplicateSlide As PowerPoint.Slide
dims activeSlide as variant.
Use this:

Dim activeSlide As PowerPoint.Slide, duplicateSlide As PowerPoint.Slide

In the same way,

'Replace some text
Dim Question, tmp, pos1, pos2, row As String

dims only row as string, the rest as variant. Use

'Replace some text
Dim Question As String, tmp As String, pos1 As String, pos2 As String, row As String

I'll let you figure this out:

'Paste this text into slide
Dim s, t As TextRange

Next, this:

'Copy chart
ActiveSheet.ChartObjects(i).Activate
ActiveChart.ChartArea.Copy
could be streamlined to

'Copy chart
ActiveSheet.ChartObjects(i).Chart.ChartArea.Copy
No need to select everything before using it.

But third, I never use placeholders when pasting an Excel chart into PowerPoint. Just

'Paste chart
objPPT.ActiveWindow.View.Paste
should paste the chart onto a slide. Then of course you'll need to position the shape you've pasted.

[aurora1827]

I can't believe I missed that about dimming, I guess my excuse is that VBA isn't my first language....:)

I use the placeholder since eventually, there will be various templates in Powerpoint that will have different size charts and tables in different locations and hardcoding all those locations and sizes seemed unpractical and difficult to update when templates change. But on the other hand, if I have all those placeholder location and sizes in a little library somewhere, I can use a blank Powerpoint for everything and don't have to keep track of templates....an idea worth pondering some more...