Sub ExportCharts_To_PPT_ActivePresentation() ' Set a VBE reference to Microsoft PowerPoint Object Library 'Paste Each Embedded Chart in the Active Worksheet into the second slide in the Active Presentation 'This procedure copies each embedded chart in the active worksheet as a picture from an Excel worksheet, 'then pastes it into the second slide of the active presentation 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 ReturnValue As Integer On Error GoTo ErrorHandling ReturnValue = MsgBox("Would you like to export all the charts of the active worksheet as PICTURE into the second slide of the ACTIVE PPT ?", vbYesNoCancel, "Exporting charts to Active PPT") 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 Set PPSlide = PPPres.Slides(2) 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 Exit Sub ErrorHandling: If Err.number = 429 Then MsgBox "The macro cannot find an open ppt presentation in which to export the graphics!" & vbCr & vbCr & _ "Please open either ..." & vbCr & _ "... (1) your ppt-presentation in which you would like the graphics to be inserted" & vbCr & _ "... (2) or just open a blank ppt-file, add a slide and activate the second slide", vbInformation, "No ppt-file found" ElseIf Err.number = -2147188160 Then MsgBox "The macro cannot find an open ppt presentation in which to export the graphics!" & vbCr & vbCr & _ "PowerPoint has been started but no file is open!", vbCritical, "No ppt-file found" Else MsgBox "The following error has occurred " & Err.number End If End Sub
From novice to tech pro — start learning today.