1

I've a vba procedure that call another procedure (addChart(cht, PptApp, oPres)), to add charts to a powerpoint presentation. When I run the full code, the procedure create a new ppt and paste the charts one by one, but arriving to a chart, I've the following error:

Run time error '-2147188160 (80048240)'

Method 'PasteSpecial' of object 'Shapes' failed

cht.Select
ActiveChart.ChartArea.Copy
PptApp.Visible = msoTrue
Set PPShape = activeSlide.Shapes.PasteSpecial(DataType:=ppPasteMetafilePicture)

            With PPShape
                .Height = 440
                .Width = 790
            End With

With the Set PPShape = activeSlide.Shapes.PasteSpecial(DataType:=ppPasteMetafilePicture) problematic line.

However, if I run the code multiple times, it will always be a different chart that will get the error, while the previous ones are pasted without any problem...

Public Sub addChart(ByVal cht As Excel.ChartObject, ByRef PptApp, ByRef oPres)

    Dim shpCurrShape As Object
    Dim activeSlide As PowerPoint.Slide

    Dim PptDoc

If cht.Name <> "Waterfall1" And cht.Name <> "Waterfall2" Then


    'Add a new slide where we will paste the chart
        PptApp.ActivePresentation.Slides.Add PptApp.ActivePresentation.Slides.Count + 1, ppLayoutText
        PptApp.ActiveWindow.View.GotoSlide PptApp.ActivePresentation.Slides.Count
        Set activeSlide = PptApp.ActivePresentation.Slides(PptApp.ActivePresentation.Slides.Count)

    'Copy the logo and paste it
        Worksheets("Page").Shapes("logo_medium").Copy
        Set PPShape = activeSlide.Shapes.PasteSpecial(DataType:=ppPasteMetafilePicture)

        With PPShape
            .Top = 30
            .Left = 40
        End With


    'Copy the chart and paste it into the PowerPoint as a Metafile Picture
        cht.Select
        ActiveChart.ChartArea.Copy
        PptApp.Visible = msoTrue
        Set PPShape = activeSlide.Shapes.PasteSpecial(DataType:=ppPasteMetafilePicture)

        With PPShape
            .Height = 440
            .Width = 790
        End With

    'Set the header
        PptApp.Visible = msoTrue
        With activeSlide
        'expression.AddTextbox(Orientation, Left, Top, Width, Height)
            Set shpCurrShape = .Shapes.AddTextbox(1, 120, 30, 654, 45)

            With shpCurrShape
                With .TextFrame.TextRange
                    '~~> Set text here
                    .Text = "Unit: " + Cells(1, 4).Value + vbCrLf + "Month: " + Cells(1, 11)
                    '~~> Alignment
                    .ParagraphFormat.Alignment = 3
                   '~~> Working with font
                   With .Font
                      .Bold = msoTrue
                      .Size = 16
                      .Color = RGB(0, 0, 0)
                   End With
                End With
            End With
        End With


    'Set the title of the slide the same as the title of the chart
        'activeSlide.Shapes(1).TextFrame.TextRange.Text = cht.Chart.ChartTitle.Text
        'activeSlide.Shapes(1).TextFrame.HorizontalAnchor = msoAnchorCenter

    'Adjust the positioning of the Chart on Powerpoint Slide
        PptApp.Visible = msoTrue
        PptApp.Visible = msoTrue
        PptApp.ActiveWindow.Selection.ShapeRange.Left = 15
        PptApp.ActiveWindow.Selection.ShapeRange.Top = 125

        activeSlide.Shapes(2).Width = 200
        activeSlide.Shapes(2).Left = 505
        With oPres.PageSetup
            PPShape.Left = (.SlideWidth / 2) - (PPShape.Width / 2)
            PPShape.Top = (.SlideHeight / 2) - (PPShape.Height / 2) + 25
        End With

        End If


End Sub

Edit: it seems that it also occurs when trying to paste the logo, every run I get the error at a different object paste (sometimes after the very first paste of the logo, sometimes after the 20th chart...)

2
  • 1
    If you want help with a script like this, we need the entire script, or a script that recreates the problem. If the line sometimes works this script doesn’t accomplish that goal
    – Ramhound
    Mar 21 '18 at 13:02
  • I add the addChart code.
    – Cromm
    Mar 21 '18 at 13:38
0

I had a problem which I'm not entirely sure is the same-one you are reporting. I think I have now resolved it by including a Sleep 100 and DoEvents prior to each paste operation.

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service, privacy policy and cookie policy

Not the answer you're looking for? Browse other questions tagged or ask your own question.