Charts in each sheet to Powerpoint

[jamesTcarville]

Hi everybody,

I have created an Excel file with multiple charts, each of them is on a
single sheet. I'm trying to create a macro to copy each slide, paste it
on a powerpoint slide, get to the next sheet, to copy the slide, paste
it on the next powerpoint slide, and so on till the end.

Here's the code. I'm stuck when I try to copy the chart.
Does anyone know a simple way to achieve that ?

Thanks

Sub GraphPowerpoint()


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

Set PPApp = CreateObject("Powerpoint.Application")
PPApp.Visible = True

Set PPPres = PPApp.Presentations.Add(msoTrue)
Set PPSlide = PPPres.Slides.Add(1, ppLayoutBlank)
PPApp.ActiveWindow.ViewType = ppViewSlide

For Each f In Worksheets

Sheets(f.Name).Activate
ActiveChart.CopyPicture Appearance:=xlScreen, Size:=xlScreen,
Format:=xlPicture

SlideCount = PPPres.Slides.Count
Set PPSlide = PPPres.Slides.Add(SlideCount + 1, ppLayoutBlank)
With PPSlide
.Shapes.Paste
End With

PPApp.ActiveWindow.Selection.ShapeRange.Align msoAlignCenters, True
PPApp.ActiveWindow.Selection.ShapeRange.Align msoAlignMiddles, True

SlideCount = SlideCount + 1

Next

End Sub

 

[Jon Peltier]

If the charts are each on their own chart sheet, not embedded on their
own worksheet, the following modifications should help.

- Jon
-------
Jon Peltier, Microsoft Excel MVP
Peltier Technical Services
Tutorials and Custom Solutions
http://PeltierTech.com/
_______


Sub GraphPowerpoint()

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 f As Object

Set PPApp = CreateObject("Powerpoint.Application")
PPApp.Visible = True

Set PPPres = PPApp.Presentations.Add(msoTrue)
Set PPSlide = PPPres.Slides.Add(1, ppLayoutBlank)
PPApp.ActiveWindow.ViewType = ppViewSlide

For Each f In ActiveWorkbook.Charts

f.Activate
ActiveChart.CopyPicture Appearance:=xlScreen, _
Size:=xlScreen, Format:=xlPicture

SlideCount = PPPres.Slides.Count
Set PPSlide = PPPres.Slides.Add(SlideCount + 1, ppLayoutBlank)
With PPSlide
.Shapes.Paste
End With

PPApp.ActiveWindow.Selection.ShapeRange.Align _
msoAlignCenters, True
PPApp.ActiveWindow.Selection.ShapeRange.Align _
msoAlignMiddles, True

SlideCount = SlideCount + 1

Next

End Sub

 

[jamesTcarville]

Thanks Jon. It works fine;;;except I have trouble with

PPApp.ActiveWindow.Selection.S­hapeRange.Align msoAlignCenters, True
PPApp.ActiveWindow.Selection.ShapeRange.Align msoAlignMiddles, True

It doesn't want to align the chart. I'm sure you know what I should do.
Thank you again.

 

[Jon Peltier]

Is the chart selected?

This
PPApp.ActiveWindow.Selection.S­hapeRange.Align msoAlignCenters, True

can be replaced with this
PPApp.ActiveWindow.Selection.sliderange.Shapes.range _
(ppapp.ActiveWindow.Selection.sliderange.Shapes.Count).align _
msoAlignCenters, True

Certainly it isn't shorter, but it might help. The PowerPoint object
model is not quite as intuitive as Excel's: no ActiveSlide object, for
example.

- Jon
-------
Jon Peltier, Microsoft Excel MVP
Peltier Technical Services
Tutorials and Custom Solutions
http://PeltierTech.com/
_______

 

[jamesTcarville]

Thanks Jon.
There must be something I don't get because it's not working fine.
Here's my code :

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 f As Object

Set PPApp = CreateObject("Powerpoint.Application")
PPApp.Visible = True

' Insère une nouvelle presentation.

Set PPPres = PPApp.Presentations.Add(msoTrue)
Set PPSlide = PPPres.Slides.Add(1, ppLayoutBlank)
PPApp.ActiveWindow.ViewType = ppViewSlide

' Copie le graphique en image

For Each f In ActiveWorkbook.Charts

Sheets(f.Name).Activate
ActiveChart.CopyPicture Appearance:=xlScreen, Size:=xlScreen,
Format:=xlPicture

SlideCount = PPPres.Slides.Count
Set PPSlide = PPPres.Slides.Add(SlideCount + 1, ppLayoutBlank)
With PPSlide
.Shapes.Paste
End With


PPApp.ActiveWindow.Selection.SlideRange.Shapes.Range(PPApp.ActiveWindow.Selection.SlideRange.Shapes.Count).Align
msoAlignCenters, True


SlideCount = SlideCount + 1

Next

Can you tell me what's wrong ? Except ME !!
Thank you.

 

[Jon Peltier]

I have noticed an error in what I posted earlier (sorry!), but the
following procedure works just fine:

Sub ChartSheetsToPowerPointSlides()
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 f As Object

Set PPApp = CreateObject("Powerpoint.Application")
PPApp.Visible = True

' Insère une nouvelle presentation.

Set PPPres = PPApp.Presentations.Add(msoTrue)
Set PPSlide = PPPres.Slides.Add(1, ppLayoutBlank)
PPApp.ActiveWindow.ViewType = ppViewSlide

' Copie le graphique en image

For Each f In ActiveWorkbook.Charts
' don't need to activate the slide
f.CopyPicture Appearance:=xlScreen, Size:=xlScreen, _
Format:=xlPicture

SlideCount = PPPres.Slides.Count
' insert new slide for each chart picture
Set PPSlide = PPPres.Slides.Add(SlideCount + 1, ppLayoutBlank)
With PPSlide
.Shapes.Paste
.Shapes.Range(.Shapes.Count).Align msoAlignCenters, True
.Shapes.Range(.Shapes.Count).Align msoAlignMiddles, True
End With

Next
End Sub

- Jon
-------
Jon Peltier, Microsoft Excel MVP
Peltier Technical Services
Tutorials and Custom Solutions
http://PeltierTech.com/
_______

 

[jamesTcarville]

Many Thanks, Jon !! It works just fine and saves me time !
Thanks again for your precious help !