ExcelBanter

ExcelBanter (https://www.excelbanter.com/)
-   Excel Programming (https://www.excelbanter.com/excel-programming/)
-   -   All charts in workbook to powerpoint (https://www.excelbanter.com/excel-programming/377082-all-charts-workbook-powerpoint.html)

Mark Ivey

All charts in workbook to powerpoint
 
Below is some code from Jon Peltier's website for transferring all charts from one worksheet to a presentation. I have tried several times to figure out how to get this to cycle through the workbook and get every chart in the workbook to do the same, but I cannot seem to figure it out. Can anyone help me with this? I have opted to paste in Jon Peltier's original code since I kept bugging up what was already there...
Thanks in advance...

--------------------------------------------------------------------------------

Sub ChartsToPresentation()
' 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

' 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
' copy chart as a picture
ActiveSheet.ChartObjects(iCht).Chart.CopyPicture _
Appearance:=xlScreen, Size:=xlScreen, Format:=xlPicture

' Add a new slide and paste in the chart
SlideCount = PPPres.Slides.Count
Set PPSlide = PPPres.Slides.Add(SlideCount + 1, ppLayoutBlank)
PPApp.ActiveWindow.View.GotoSlide PPSlide.SlideIndex
With PPSlide
' paste and select the chart picture
.Shapes.Paste.Select
' align the chart
PPApp.ActiveWindow.Selection.ShapeRange.Align msoAlignCenters, True
PPApp.ActiveWindow.Selection.ShapeRange.Align msoAlignMiddles, True
End With

Next

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

End Sub
--------------------------------------------------------------------------------

NickHK

All charts in workbook to powerpoint
 
Mark,
I would assume you need to add another loop to cycle through all the
worksheets. e.g.
Dim WS as worksheet

For each ws in thisworkbook.worksheet
'For iCht = 1 To ActiveSheet.ChartObjects.Count
For iCht = 1 To WS.ChartObjects.Count
'Code, adjusted to WS instead of ActiveSheet
Next
Next

NickHK

"Mark Ivey" wrote in message
...
Below is some code from Jon Peltier's website for transferring all charts
from one worksheet to a presentation. I have tried several times to figure
out how to get this to cycle through the workbook and get every chart in the
workbook to do the same, but I cannot seem to figure it out. Can anyone help
me with this? I have opted to paste in Jon Peltier's original code since I
kept bugging up what was already there...
Thanks in advance...



Sub ChartsToPresentation()
' 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

' 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
' copy chart as a picture
ActiveSheet.ChartObjects(iCht).Chart.CopyPicture _
Appearance:=xlScreen, Size:=xlScreen, Format:=xlPicture

' Add a new slide and paste in the chart
SlideCount = PPPres.Slides.Count
Set PPSlide = PPPres.Slides.Add(SlideCount + 1, ppLayoutBlank)
PPApp.ActiveWindow.View.GotoSlide PPSlide.SlideIndex
With PPSlide
' paste and select the chart picture
.Shapes.Paste.Select
' align the chart
PPApp.ActiveWindow.Selection.ShapeRange.Align msoAlignCenters, True
PPApp.ActiveWindow.Selection.ShapeRange.Align msoAlignMiddles, True
End With

Next

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

End Sub



Mark Ivey

All charts in workbook to powerpoint
 
Outstanding Nick,

I was close to what you were showing here, but I was unsure of what to do
with the other ActiveSheet references.

Thanks a million...

Mark Ivey

"NickHK" wrote in message
...
Mark,
I would assume you need to add another loop to cycle through all the
worksheets. e.g.
Dim WS as worksheet

For each ws in thisworkbook.worksheet
'For iCht = 1 To ActiveSheet.ChartObjects.Count
For iCht = 1 To WS.ChartObjects.Count
'Code, adjusted to WS instead of ActiveSheet
Next
Next

NickHK

"Mark Ivey" wrote in message
...
Below is some code from Jon Peltier's website for transferring all charts
from one worksheet to a presentation. I have tried several times to figure
out how to get this to cycle through the workbook and get every chart in
the
workbook to do the same, but I cannot seem to figure it out. Can anyone
help
me with this? I have opted to paste in Jon Peltier's original code since I
kept bugging up what was already there...
Thanks in advance...



Sub ChartsToPresentation()
' 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

' 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
' copy chart as a picture
ActiveSheet.ChartObjects(iCht).Chart.CopyPicture _
Appearance:=xlScreen, Size:=xlScreen, Format:=xlPicture

' Add a new slide and paste in the chart
SlideCount = PPPres.Slides.Count
Set PPSlide = PPPres.Slides.Add(SlideCount + 1, ppLayoutBlank)
PPApp.ActiveWindow.View.GotoSlide PPSlide.SlideIndex
With PPSlide
' paste and select the chart picture
.Shapes.Paste.Select
' align the chart
PPApp.ActiveWindow.Selection.ShapeRange.Align msoAlignCenters, True
PPApp.ActiveWindow.Selection.ShapeRange.Align msoAlignMiddles, True
End With

Next

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

End Sub






All times are GMT +1. The time now is 11:26 PM.

Powered by vBulletin® Copyright ©2000 - 2025, Jelsoft Enterprises Ltd.
ExcelBanter.com