Can I paste a chart from Excel into a powerpoint slide "Placeholde

M

Mats Teir

I have a macro to transfer Excel graphs into PowerPoint slides, which works
fine, but the pasted graphs (pictures) are (with original shape pasted across
teh slide. I would like them to get pasted into the "Placeholder" that is
automatically created on a new slide.
Anyone have an idea how to get this done?

Thanks in advance

Mats


Sub TransferGraphs()
'
' TransferGraphs Macro
' Transfer all graphs on selected worksheet as pictures to PPT file
'

Dim PPApp As PowerPoint.Application
Dim PPPres As PowerPoint.Presentation
Dim PPSlide As PowerPoint.Slide
Dim PresentationFileName As Variant
Dim SlideCount As Long
Dim iCht As Integer
Dim sTitle As String

' Create instance of PowerPoint
Set PPApp = CreateObject("Powerpoint.Application")

' For automation to work, PowerPoint must be visible
' (alternatively, other extraordinary measures must be taken)
PPApp.Visible = True

' Create a presentation
Set PPPres = PPApp.Presentations.Add

PPApp.ActiveWindow.ViewType = ppViewSlide

For iCht = 1 To ActiveSheet.ChartObjects.Count
With ActiveSheet.ChartObjects(iCht).Chart

' get chart title
If .HasTitle Then
sTitle = .ChartTitle.Text
Else
sTitle = ""
End If

' remove title (or it will be redundant)
.HasTitle = False

' copy chart as a picture
.CopyPicture _
Appearance:=xlScreen, Size:=xlScreen, Format:=xlPicture

' restore title
If Len(sTitle) > 0 Then
.HasTitle = True
.ChartTitle.Text = sTitle
End If
End With

' Add a new slide and paste in the chart
SlideCount = PPPres.Slides.Count
Set PPSlide = PPPres.Slides.Add(SlideCount + 1, ppLayoutObject)
PPApp.ActiveWindow.View.GotoSlide PPSlide.SlideIndex
With PPSlide
' paste and select the chart picture
.Shapes.Paste.Select
' align the chart TO THE MIDDLE OF THE SLIDE AND INSERT THE SLIDE
TITLE (COPIED FROM THE GRAPH)
PPApp.ActiveWindow.Selection.ShapeRange.Align msoAlignCenters, True
PPApp.ActiveWindow.Selection.ShapeRange.Align msoAlignMiddles, True
.Shapes.Placeholders(1).TextFrame.TextRange.Text = sTitle
End With

Next

' Save and close presentation
With PPPres
.SaveAs "C:\MACROTEST\MACROTEST.ppt"
.Close
End With

' Quit PowerPoint
' PPApp.Quit

' Clean up
Set PPSlide = Nothing
Set PPPres = Nothing
Set PPApp = Nothing

End Sub
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Top