pastespecial форм объекта не удалось VBA
У меня есть этот код для копирования диаграмм из листа Excel 2010 в PowerPoint. Он просматривает все диаграммы на активном листе, затем копирует и вставляет ссылку в PowerPoint. Существует также небольшой фрагмент кода, который берет заголовок диаграммы и помещает его в качестве заголовка в PowerPoint.
В большинстве случаев он отлично работает для меня, однако выдает ошибку времени выполнения -2147467259 (80004005). Метод «PasteSpecial» объекта «Shapes» завершился ошибкой после перемещения 9 диаграмм в powerpoint. Что может быть причиной этого сбоя в середине работы отлично?
Sub CreatePowerPoint()
'Add a reference to the Microsoft PowerPoint Library by:
Dim newPowerPoint As PowerPoint.Application
Dim activeSlide As PowerPoint.Slide
Dim cht As Excel.ChartObject
'Look for existing instance
On Error Resume Next
Set newPowerPoint = GetObject(, "PowerPoint.Application")
On Error GoTo 0
'Let's create a new PowerPoint
If newPowerPoint Is Nothing Then
Set newPowerPoint = New PowerPoint.Application
End If
'Make a presentation in PowerPoint
If newPowerPoint.Presentations.Count = 0 Then
newPowerPoint.Presentations.Add
End If
'Show the PowerPoint
newPowerPoint.Visible = True
'Loop through each chart in the Excel worksheet and paste them into the PowerPoint
For Each cht In ActiveSheet.ChartObjects
'Add a new slide where we will paste the chart
newPowerPoint.ActivePresentation.Slides.Add newPowerPoint.ActivePresentation.Slides.Count + 1, ppLayoutText
newPowerPoint.ActiveWindow.View.GotoSlide newPowerPoint.ActivePresentation.Slides.Count
Set activeSlide = newPowerPoint.ActivePresentation.Slides(newPowerPoint.ActivePresentation.Slides.Count)
'Copy the chart and paste it into the PowerPoint
cht.Select
ActiveChart.ChartArea.Copy
activeSlide.Shapes.PasteSpecial(Link:=True).Select
'Set the title of the slide the same as the title of the chart
If ActiveChart.HasTitle = True Then
activeSlide.Shapes(1).TextFrame.TextRange.Text = cht.Chart.ChartTitle.Text
Else
activeSlide.Shapes(1).TextFrame.TextRange.Text = "Add Title"
End If
'Adjust the positioning of the Chart on Powerpoint Slide
newPowerPoint.ActiveWindow.Selection.ShapeRange.Left = 0.5 * 72
newPowerPoint.ActiveWindow.Selection.ShapeRange.Top = 1.75 * 72
newPowerPoint.ActiveWindow.Selection.ShapeRange.LockAspectRatio = msoFalse
newPowerPoint.ActiveWindow.Selection.ShapeRange.Height = 5.5 * 72
newPowerPoint.ActiveWindow.Selection.ShapeRange.Width = 8.92 * 72
Next
AppActivate ("Microsoft PowerPoint")
Set activeSlide = Nothing
Set newPowerPoint = Nothing
End Sub