Help Run-Time Error for Excel to PPT Export!!!!

[Kacer26]

Hello All!

So I'm running this code to extract multiple charts (2) from each worksheet in a workbook and then paste each chart to a seperate powerpoint slide.

When the code is run, I get the following error:

Line of Code: Set PPTShape = PPSlide.Shapes.PasteSpecial(link:=True)

And the Run-Time Error says:

Shapes (Unkown Member): Invalid request. The specified data type is unavailable

What does this mean?

NOTE: I do have my MS PPT Object Library activated - do I need to activate another object library to run the macro?

 

[Trevor G]

Have a look at this code I use it to get a chart into PowerPoint, it doesn't link it though

Sub CreateNewPowerPointPresentation()
' to test this code, paste it into an Excel module
' add a reference to the PowerPoint-library
' create a new folder named C:\Foldername or edit the filnames in the code
Dim pptApp As PowerPoint.Application
Dim pptPres As PowerPoint.Presentation
Dim pptSlide As PowerPoint.Slide
Dim pptShape As PowerPoint.Shape
Dim i As Integer, strString As String
Set pptApp = CreateObject("PowerPoint.Application")
Set pptPres = pptApp.Presentations.Add(msoTrue) ' create a new presentation
' or open an existing presentation
' Set pptPres = pptApp.Presentations.Open("C:\Foldername\Filename.ppt")

' apply a slide template you need to know which version you are using and the location
pptPres.ApplyTemplate "C:\Program Files\Microsoft Office\Templates\Presentation Designs\Globe.pot"
With pptApp
.Visible = True

End With

With pptPres.Slides
Set pptSlide = .Add(.Count + 1, ppLayoutText) ' add a slide
End With
With pptSlide ' add contents to a slide
.Shapes(1).TextFrame.TextRange.Text = "Slide Title" ' add a slide title
For i = 1 To 5 ' create slide text content
strString = strString & "Item number #" & i & Chr(13)
Next i
strString = Left$(strString, Len(strString) - 1)
.Shapes(2).TextFrame.TextRange.Text = strString ' add text content
End With

ThisWorkbook.Worksheets(1).Range("A3:D10").Copy ' copy an Excel range

With pptPres.Slides
Set pptSlide = .Add(.Count + 1, ppLayoutText) ' add a slide
End With
With pptSlide
.Shapes(1).TextFrame.TextRange.Text = "Slide Title" ' add a slide title
.Shapes(2).Delete ' remove the text box
'.Shapes.Paste
With .Shapes(.Shapes.Count)
.Left = 50
.Top = 100
.Width = 600
.Height = 400
End With
End With

With pptPres.Slides
Set pptSlide = .Add(.Count + 1, ppLayoutText) ' add a slide
End With
With pptSlide
.Shapes(1).TextFrame.TextRange.Text = "Slide Title" ' add a slide title
.Shapes(2).Delete ' remove the text box
.Shapes.PasteSpecial ppPasteBitmap
With .Shapes(.Shapes.Count)
.Left = 50
.Top = 150
.Width = 600
'.Height = 250
End With
End With

With pptPres.Slides
Set pptSlide = .Add(.Count + 1, ppLayoutText) ' add a slide
End With
With pptSlide
.Shapes(1).TextFrame.TextRange.Text = "Slide Title" ' add a slide title
.Shapes(2).Delete ' remove the text box
'.Shapes.PasteSpecial ppPasteOLEObject
With .Shapes(.Shapes.Count)
.Left = 50
.Top = 150
.Width = 600
'.Height = 250
End With
End With

ThisWorkbook.Worksheets(1).ChartObjects(1).Copy ' copy an Excel chart item
With pptPres.Slides
Set pptSlide = .Add(.Count + 1, ppLayoutTitleOnly) ' add a slide
End With
With pptSlide
.Shapes(1).TextFrame.TextRange.Text = "Slide Title" ' add a slide title
.Shapes.PasteSpecial ppPasteDefault
With .Shapes(.Shapes.Count)
.Left = 120
.Top = 125.125
.Width = 480
.Height = 289.625
End With
End With

' ThisWorkbook.Charts(1).ChartArea.Copy ' copy an Excel chart
' With pptPres.Slides
' Set pptSlide = .Add(.Count + 1, ppLayoutTitleOnly) ' add a slide
' End With
' With pptSlide
' .Shapes(1).TextFrame.TextRange.Text = "Slide Title" ' add a slide title
' .Shapes.PasteSpecial ppPasteDefault
' With .Shapes(.Shapes.Count)
' .Left = 120
' .Top = 125.125
' .Width = 480
' .Height = 289.625
' End With
' End With

Application.CutCopyMode = False ' end cut/copy from Excel
Set pptSlide = Nothing

On Error Resume Next ' ignore errors
Kill "C:\Foldername\MyNewPresentation.ppt"
With pptPres
.SaveAs "C:\Foldername\MyNewPresentation.ppt"
'.Close ' close the presentation
End With
On Error GoTo 0 ' resume normal error handling
Set pptPres = Nothing

pptApp.Visible = True ' display the application
'pptApp.Quit ' or close the PowerPoint application
Set pptApp = Nothing
End Sub