Copy and paste large number of charts from Excel to Power Point via VBA-CodePudding

I know there are already numerous posts on how to copy things from excel to ppt with VBA on this page (and many of those already helped me out) but I have a rather strange problem I haven't seen addressed:

The task is fairly standard: loop through an excel workbook with multiple sheets and copy all the charts contained in the workbook into a ppt presentation, one chart per slide and always the same layout. Below the code I use for this

Sub PPT_Example()
    Dim pptApp As PowerPoint.Application
    Dim pptPres As PowerPoint.Presentation
    Dim sh As Worksheet
    Dim ch As ChartObject

    Set pptApp = New PowerPoint.Application
    pptApp.Visible = True
    Set pptPres = pptApp.Presentations.Add
    pptPres.PageSetup.SlideSize = PpSlideSizeType.ppSlideSizeOnScreen16x9

    For Each sh In ActiveWorkbook.Sheets
            For Each ch In sh.ChartObjects
                Dim pptSlide As Slide
                Dim Title As Object
                Dim Box As Object
                Dim Txt As Object
                Set pptSlide = pptPres.Slides.Add(pptPres.Slides.Count   1, ppLayoutBlank)
                ch.Copy
                With pptSlide.Shapes.Paste
                    .Top = Application.CentimetersToPoints(3.3)
                    .Left = Application.CentimetersToPoints(0.76)
                    .Width = Application.CentimetersToPoints(16)
                    .Height = Application.CentimetersToPoints(10.16)
                End With
            'Insert Box
            Set Box = pptSlide.Shapes.AddShape(Type:=msoShapeRectangle, _
            Left:=Application.CentimetersToPoints(17.1), _
            Top:=Application.CentimetersToPoints(3.3), _
            Width:=Application.CentimetersToPoints(7.22), _
            Height:=Application.CentimetersToPoints(9.29))
            Prop_Box.Name = "Box"
            pptSlide.Shapes("Box").Fill.ForeColor.RGB = RGB(219, 233, 255)
            pptSlide.Shapes("Box").Line.ForeColor.RGB = RGB(0, 102, 255)
            
            'Insert the text box
            Set Txt = pptSlide.Shapes.AddTextbox(Orientation:=msoTextOrientationHorizontal, _
            Left:=Application.CentimetersToPoints(17.1), _
            Top:=Application.CentimetersToPoints(3.3), _
            Width:=Application.CentimetersToPoints(7.22), _
            Height:=Application.CentimetersToPoints(9.29))
            Txt.Name = "Txt"
            pptSlide.Shapes("Txt").TextFrame.TextRange.Font.Size = 14
            pptSlide.Shapes("Txt").TextFrame.TextRange.Font.Bold = msoCTrue
            pptSlide.Shapes("Txt").TextFrame.TextRange.Font.Name = "Arial"
            pptSlide.Shapes("Txt").TextFrame.TextRange.Text = "Sample Text"
            
            'Clear the Clipboard
            Dim oData   As New DataObject 'object to use the clipboard
            oData.SetText Text:=Empty 'Clear
            oData.PutInClipboard
            Next
    Next
End Sub

Above code works fine if I use it on my toy example (2 sheets, 3 charts total) but not if I apply it to the real thing, which is a workbook with 10-15 sheets and 8 charts per sheet. There it starts as it should but at some (random?) point, the code stops and gives me this error message

Run-time error: Shapes (unknown member): Invalid request. Clipboard is empty or contains data which may not be pasted here.

I noted that the code crashed earlier, the more objects I put on the slides (which is why I left the text and the box in my example, although not strictly neccessary). Given that and the error message, I assumed the clipboard might not be cleared properly after each loop, so I put in a section to clear the clipboard but it didn't solve the issue.

Any ideas?

Cheers

CodePudding user response：

After the chart is copied, try adding DoEvents and pausing the macro for a few seconds before pasting it into your slide. And the same thing after it's pasted into your slide.

So, for example, first add the following function to pause your code . . .

Sub PauseMacro(ByVal secs As Long)

    Dim endTime As Single
    endTime = Timer   secs
    
    Do
        DoEvents
    Loop Until Timer > endTime
    
End Sub

Then try something like this . . .

            ch.Copy
            
            DoEvents
            
            PauseMacro 5 'pause for 5 seconds
            
            With pptSlide.Shapes.Paste
                DoEvents
                PauseMacro 5 'pause for 5 seconds
                .Top = Application.CentimetersToPoints(3.3)
                .Left = Application.CentimetersToPoints(0.76)
                .Width = Application.CentimetersToPoints(16)
                .Height = Application.CentimetersToPoints(10.16)
            End With

You may find through testing that you can pause for less than 5 seconds, maybe 3 seconds.