Question

我想编写一个VBA宏，它可以从Excel中复制几张图表并将其粘贴到已创建的PowerPoint演示文稿中的不同幻灯片中（PPT未打开，代码应该可以这样做）。

我尝试过这样做，但它总是会出现一些或其他错误，例如“ActiveX组件不存在”。我也阅读了很多这个问题的解决方案但是所有这些解决方案看起来都太乱了。有人可以建议一个清晰，干净的方法吗？这将非常有帮助！

宏将在Excel中 。请找到以下代码：

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

突出显示的行给出错误：“ActiveX组件无法创建对象” 谢谢！

使用VBA宏将图表从Excel复制到PPT

0 个答案: