Ich habe diesen Code zum Kopieren von Diagrammen aus einem Excel 2010-Arbeitsblatt in PowerPoint. Es durchläuft die Suche nach allen Diagrammen im aktiven Arbeitsblatt, kopiert einen Link und fügt ihn in PowerPoint ein. Es gibt auch einen kleinen Codeausschnitt, der den Diagrammtitel aufnimmt und als Titel in PowerPoint einfügt.

In den meisten Fällen funktioniert es einwandfrei, es wird jedoch ein Laufzeitfehler angezeigt -2147467259 (80004005) Die Methode 'PasteSpecial' des Objekts 'Shapes' ist fehlgeschlagen, nachdem 9 Diagramme in Powerpoint verschoben wurden. Was könnte diesen Fehler in der Mitte des perfekten Laufs verursachen?

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