2

I want to write a VBA Macro which copies few charts from Excel and pastes it in different slides in an already created PowerPoint Presentation( the PPT is not open, the code should be able to do that).

I have tried doing that but it always gives some or the other error like "ActiveX component does not exist". I also read many solutions to this problem but all of them seem too messy. Can someone suggest a clear and clean method to do that? It would be very helpful!

The Macro will be in Excel. Please find the code below:

Sub ExcelToPres()
Dim PPT As Object
Set PPT = CreateObject("PowerPoint.Application")
PPT.Visible = True
PPT.Presentations.Open Filename:="path"
copy_chart "sheet_name", 2  ' Name of the sheet to copy graph and slide number the graph is to be pasted in
PPT.Save
PPT.Close
End Sub


Public Function copy_chart(sheet, slide)


Dim PPApp As Object
Dim PPPres As Object
Dim PPSlide As Object

Set PPApp = CreateObject("Powerpoint.Application")
***Set PPPres = CreateObject("Powerpoint.Presentation")***
Set PPSlide = CreateObject("Powerpoint.Slide")

Set PPApp = GetObject(, "Powerpoint.Application")
Set PPPres = PPApp.ActivePresentation
PPApp.ActiveWindow.ViewType = ppViewSlide
PPApp.ActiveWindow.View.GotoSlide (slide)

Worksheets(sheet).Activate
ActiveSheet.ChartObjects("Chart 1").Chart.CopyPicture _
Appearance:=xlScreen, Size:=xlScreen, Format:=xlPicture


'PPApp.ActiveWindow.View.GotoSlide PPSlide.SlideIndex

Set PPSlide = PPPres.Slides(PPApp.ActiveWindow.Selection.SlideRange.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

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

End Function

The highlighted line is giving the error: " ActiveX Component cannot create object " Thanks!!

4

0 回答 0