pastespecial de formas de objetos fallidos vba
Tengo este código para copiar gráficos de una hoja de cálculo de Excel 2010 en PowerPoint. Recorre las búsquedas de todos los gráficos en la hoja de cálculo activa, luego copia y pega un enlace en PowerPoint. También hay un pequeño fragmento de código que toma el título del gráfico y lo coloca como un título en PowerPoint.
Funciona perfectamente para mí en la mayoría de los casos, sin embargo, me está dando un error de tiempo de ejecución -2147467259 (80004005) Método 'PasteSpecial' de objeto 'Formas' falló después de que 9 gráficos se hayan movido a PowerPoint. ¿Qué podría estar causando este fallo en medio de correr perfectamente?
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