☰

自动化错误灾难性故障

tag-icon • tag-icon microsoft-excel vba microsoft-powerpoint
自动化错误灾难性故障

我正在尝试使用 excel VBA 将一些图表复制到 Powerpoint 幻灯片中，代码如下，但它显示错误“自动化错误灾难性故障”。我不知道问题是什么。我想知道 excel 文件大小是否太大。我该如何解决这个问题？

Sub ExcelToPres()
Dim PPT As Object
Set PPT = CreateObject("PowerPoint.Application")
PPT.Visible = True
PPT.Presentations.Open Filename:="C:\test\test.pptx"
copy_chart "Sheet1", 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 PPApp = GetObject(, "Powerpoint.Application")
Set PPPres = PPApp.ActivePresentation
'PPApp.ActiveWindow.ViewType = ppViewSlide
PPApp.ActiveWindow.View.GotoSlide (slide)

Worksheets("Sheet1").Activate
ActiveSheet.ChartObjects("Chart 13").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

答案1

您的一个例程应该调用 PPT 并获取一个 PPT 对象来处理，而不是同时调用两者。

我立即怀疑的一件事是 copy_chart 中的清理例程正在关闭 PPT 应用程序对象，因此当控制权返回到调用子例程时，该对象为空。如果错误发生在“PPT.Save”行上，我会押注于此。;-)

无论如何，您发布的代码中还有其他一些不好的做法。例如，除非需要，否则永远不要在 PPT 中选择任何内容。改用对象引用。我对您的示例代码进行了大量修改，但尚未在此处测试；请接受它的价值，但请尝试一下。

Sub ExcelToPres()
Dim PPT As Object
Dim PPTPres as Object
Set PPT = CreateObject("PowerPoint.Application")
PPT.Visible = True
Set PPTPres = PPT.Presentations.Open Filename:="C:\test\test.pptx"
copy_chart "Sheet1", 2, PPTPres  ' Name of the sheet to copy graph and slide number the graph is to be pasted in
PPTPres.Save
PPTPres.Close
' optionally
PPT.Quit

End Sub


Public Function copy_chart(sheet as String, lSlide as Long, PPTPres as Object)

Dim PPSlide As Object
Dim PPShapeRange as Object

Worksheets("Sheet1").Activate
ActiveSheet.ChartObjects("Chart 13").Chart.CopyPicture _ ****
Appearance:=xlScreen, Size:=xlScreen, Format:=xlPicture 

Set PPSlide = PPTPres.Slides(lSlide)

With PPSlide
' paste and select the chart picture
set PPShapeRange = .Shapes.Paste

' align the chart
With PPShapeRange
.Align msoAlignCenters, True
.Align msoAlignMiddles, True
End With


End Function

相关内容