Excel Chart macro to paste into Powerpoint

D

ddate

I have passed along this code to someone using office 2007 and it does not
work. It works fine in Office 2003 but wondering if something is amiss with
2007.

It is getting stuck at Dim PPApp As PowerPoint.Application and says "Compile
error, user-defined type not defined".

Please help.

Sub ChartToPresentation()
' Set a VBE reference to Microsoft PowerPoint Object Library

Dim PPApp As PowerPoint.Application
Dim PPPres As PowerPoint.Presentation
Dim PPSlide As PowerPoint.Slide

' Make sure a chart is selected
If ActiveChart Is Nothing Then
MsgBox "Please select a chart and try again.", vbExclamation, _
"No Chart Selected"
Else
' Reference existing instance of PowerPoint
Set PPApp = GetObject(, "Powerpoint.Application")
' Reference active presentation
Set PPPres = PPApp.ActivePresentation
PPApp.ActiveWindow.ViewType = ppViewSlide
' Reference active slide
Set PPSlide = PPPres.Slides _
(PPApp.ActiveWindow.Selection.SlideRange.SlideIndex)

' Copy chart as a picture
ActiveChart.CopyPicture Appearance:=xlScreen, Size:=xlScreen, _
Format:=xlBitmap

' Paste chart
PPSlide.Shapes.Paste.Select

' Align pasted chart
PPApp.ActiveWindow.Selection.ShapeRange.Align msoAlignCenters, True
PPApp.ActiveWindow.Selection.ShapeRange.Align msoAlignMiddles, True

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

End Sub
 
D

ddate

Thank you Jon for your response. I have now copied your website into the
code so I know where to look if questions arise.

I was wondering if you knew of a way to have the Excel paste into Powerpoint
to fit into the size of the slide. In Powerpoint this can be done manually
with those borders that appear in the slide template. I haven't been able to
figure out a way to avoid resizing with each paste.

Thanks again for your expertise.
 
Y

Yurble

Hey All,

I have used the code in given link, it really works. It's great.
Thanks Jon

One point I noted is, as you know, when copy chart as picture, it will
increase the size of ppt file. And another point is that we can not
update chart in Powerpoint.

Is there anyway to copy linked chart instead?

Once again, thanks you very much
 
Y

Yurble

Finally success in modifying the code to paste link

Now, just wonder, is there anyway to export all workbook, instead of
each worksheet...


Sub ChartsAndTitlesToPresentation()
' Set a VBE reference to Microsoft PowerPoint Object Library

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

' Reference existing instance of PowerPoint
Set PPApp = GetObject(, "Powerpoint.Application")


' Reference active presentation
Set PPPres = PPApp.ActivePresentation
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
.ChartArea.Copy

' 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, ppLayoutTitleOnly)
PPApp.ActiveWindow.View.GotoSlide PPSlide.SlideIndex
With PPSlide
' paste and select the chart picture
.Shapes.PasteSpecial(Link:=True).Select
' align the chart
PPApp.ActiveWindow.Selection.ShapeRange.Align msoAlignCenters,
True
PPApp.ActiveWindow.Selection.ShapeRange.Align msoAlignMiddles,
True
.Shapes.Placeholders(1).TextFrame.TextRange.Text = sTitle
End With

Next

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

End Sub
 
J

Jon Peltier

I'm not sure I should bother to answer, because within a day you seem to
figure out each successive question.

What you can do is something like this:

For j=1 to ActiveWorkbook.Worksheets.Count
For i = 1 to ActiveWorkbook.Worksheets(j).ChartObjects.Count
With ActiveWorkbook.Worksheets(j).ChartObjects(i).Chart
' insert the existing code here
End With
Next i
Next j

- Jon
 
Y

Yurble

Thanks Jon,

you are so kind.

BTW, can I have your help in this case: how it would be for the code
run in MS excel 2007. I have tried to use the code above to run in
Excel 2007, but it failed. Even if I have changed some thing as
mention in your site (later binding).
The command:

.Shapes.PasteSpecial(Link:=True).Select

seems not work in Excel 2007

Thanks
 
J

Jon Peltier

I saw your posts about using this code in Excel 2007. Unfortunately the
laptop on which I have Excel 2007 installed was immersed in water when a
bathroom flooded and leaked onto the kitchen table below. If & when it dries
out, I will try it again, or I'll have to install Excel 2007 onto another
machine.

If I haven't posted within a few days, email me directly so it doesn't slip
below my radar screen.

- Jon
 
C

Casey

I have followed all of the directions listed, but still cannot get PPT
to launch. If
I have PPT already open, the rest of the macro runs perfectly. I have
PPT 2003
AND PPT 2007 installed on my computer, will I need to uninstall one of
them
in order for this to work? (I currently use both because my clients have
different versions for when I send output).


Casey
(e-mail address removed)

*** Sent via Developersdex http://www.developersdex.com ***
 
Y

Yurble

Try to remove follow:

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

2.
If Len(sTitle) > 0 Then
.HasTitle = True
.ChartTitle.Text = sTitle
End If

And remember to Set a VBE reference to Microsoft PowerPoint Object
Library
 
H

Henk

I want to convert the following code from Early binding to Late binding.
Anyone any idea how to do that?

Public Sub ChartToPowerPoint()
Application.ScreenUpdating = False
Dim PPApp As PowerPoint.Application
Dim PPPres As PowerPoint.Presentation
Dim PPSlide As PowerPoint.Slide
Dim NewIndex As Integer
Dim ChartName As String
ChartName = ActiveSheet.Name
ActiveSheet.ChartObjects(ChartName).Activate
ActiveChart.ChartArea.Select
ActiveChart.CopyPicture Appearance:=xlScreen, Size:=xlScreen,
Format:=xlBitmap
Set PPApp = GetObject(, "Powerpoint.Application")
Set PPPres = PPApp.ActivePresentation
PPApp.ActiveWindow.ViewType = ppViewNormal
NewIndex = PPPres.Slides.Count + 1
PPPres.Slides.Add(Index:=NewIndex, Layout:=ppLayoutBlank).Select
Set PPSlide =
PPPres.Slides(PPApp.ActiveWindow.Selection.SlideRange.SlideNumber)
PPApp.ActiveWindow.ViewType = ppViewSlide
PPSlide.Shapes.Paste.Select
PPApp.ActiveWindow.Selection.ShapeRange.Height = 303.5
PPApp.ActiveWindow.Selection.ShapeRange.Align msoAlignCenters, True
PPApp.ActiveWindow.Selection.ShapeRange.Align msoAlignMiddles, True
PPApp.ActiveWindow.ViewType = ppViewNormal
Set PPSlide = Nothing
Set PPPres = Nothing
Set PPApp = Nothing
End Sub

Hope you can help me out.

Henk
 
D

Daemen

The code below works in office 2007 for me:

don't forget to DIM PP and PPpres as object.

Set PP = GetObject(, "PowerPoint.Application")
PP.Visible = msoCTrue
Set PPpres = PP.Presentations("Template.pptx")

ActiveSheet.Shapes("myGraph").Copy

PPpres.Slides(5).Shapes.PasteSpecial (ppPasteEnhancedMetafile)

This works like a charm... almost....

My problem is that the graph loses all preselected colours. And the colours
had meaning. If I do this operation by hand: copy the graph, go to powerpoint
and select paste-special Picture("Enhanced Metafile"), then it works
perfectly and all colours are retained. How do i get the macro to do this?

I hope I have helped you. Now allow me to hijack this thread? ;-)
 

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

Similar Threads

Early bind to Late bind 3
Early bound to Late bound 2
From Early bnind to Late bind 1
From Early to Late bind 3
opening up Powerpoint slide from Excel 2
Range Link and Chart Link Macros 1
From Early to Late bind 0
From Early to Late bind 0

Top