Ошибка автоматизации катастрофического сбоя

Question

Я пытаюсь использовать 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

Answer 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