I have this code to copy charts from an Excel 2010 worksheet into powerpoint. It loops through searches for all charts on the active worksheet then copy and pastes a link into powerpoint. There is also a small snippet of code that takes the chart title and puts it as a title into PowerPoint.
It works perfectly for me in most instances, however it is giving me a runtime error -2147467259 (80004005) Method 'PasteSpecial' of object 'Shapes' failed after 9 charts have been moved into powerpoint. What could be causing this failure in the middle of running perfectly?
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
See Question&Answers more detail:
os 与恶龙缠斗过久,自身亦成为恶龙;凝视深渊过久,深渊将回以凝视…