VBA Embedded Excel Graphs to Powerpoint (with a twist)

Kattenhove

New Member
Joined
Sep 24, 2014
Messages
2
Hi there,

Hoping someone is able to help a struggling amateur - would be greatly appreciated.
So I have a workbook with a set of worksheets each containing graphs relevant for a specific project.

Firstly I would love to create a macro that loops through each worksheet, and for each sheet, it then paste all graph objects to a NEW powerpoint presentation. This would allow me to quickly assemble my work for presentations.

Another way to go about it would be to be able to have the user select from a list of the worksheet names (projects) and have it subsequently export all graphs from the relevant sheet to a new powerpoint presentation.

I have tried with amateur alterations of Jon Peltier's code (included below), but I'm hopeful someone have had the same need or can trivially help me ammend the code to my needs!

/Thanks!

Code:
[COLOR=#0000CC][FONT=courier new][B]Sub ChartsToPresentation()[/B][/FONT][/COLOR]' 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
 [COLOR=#0000CC][FONT=courier new][B]End Sub[/B][/FONT][/COLOR]
 

Some videos you may like

Excel Facts

Formula for Yesterday
Name Manager, New Name. Yesterday =TODAY()-1. OK. Then, use =YESTERDAY in any cell. Tomorrow could be =TODAY()+1.

Watch MrExcel Video

Forum statistics

Threads
1,123,385
Messages
5,601,329
Members
414,445
Latest member
walramgo02

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Top