Executemso error after using it to post a chart from excel to ppt

问题

I'm current using vba to automate the creation of a ppt report. I need to copy charts from excel and paste into ppt. I successfully used the ExecuteMso "PasteExcelChartSourceFormatting" to paste the chart in, which I need to use so I can paste while keeping the source formatting and embedding the workbook, but I keep getting an error after that when my code tries to reposition the chart in ppt. See code:

Sub Update()

    Dim ppApp As PowerPoint.Application
    Dim ppPres As PowerPoint.Presentation
    Dim ppSlide As PowerPoint.Slide


    Set ppApp = New PowerPoint.Application

    ppApp.Visible = True
    ppApp.Activate

    Set ppPres = ppApp.Presentations.Open("C:\Users\ashah\Documents\Advisory.pptx")

    ppPres.Slides(1).Shapes(7).Delete
    Sheet1.ChartObjects("Chart 24").Chart.ChartArea.Copy
    ppPres.Slides(1).Select
    DoEvents

    ppApp.CommandBars.ExecuteMso "PasteExcelChartSourceFormatting"
    ppApp.CommandBars.ReleaseFocus
    DoEvents

    ppPres.Slides(1).Shapes(7).Left = _
      (ppPres.PageSetup.SlideWidth / 2) - (ppPres.Slides(1).Shapes(7).Width / 2)
    ppPres.Slides(1).Shapes(7).Top = 77

End Sub

I get a run-time error '--2147188160 (80048240)', method 'Item' of object 'Shapes' failed. The debug highlights the last few lines of my code.

Any advice would be greatly appreciated!

回答1:

Can you try this, slightly different method

Sub Update()
    Dim ppApp As PowerPoint.Application
    Dim ppPres As PowerPoint.Presentation
    Dim ppSlide As PowerPoint.Slide

    Set ppApp = New PowerPoint.Application

    ppApp.Visible = True
    ppApp.Activate

    Set ppPres = ppApp.Presentations.Open("C:\Users\ashah\Documents\Advisory.pptx")
    Set ppSlide = ppPres.Slides(1)
    ppSlide.Shapes(7).Delete

    Sheet1.ChartObjects(1).Chart.ChartArea.Copy

    ppSlide.Shapes.Paste.Select

    With ppPres.Windows(1).Selection.ShapeRange
        .Left = (ppPres.PageSetup.SlideWidth / 2) - (.Width / 2)
        .Top = 77
    End With

End Sub

UPDATE: I split this into two subs. Can you give this a try

Sub Update()
    Dim ppApp As PowerPoint.Application
    Dim ppPres As PowerPoint.Presentation
    Dim ppSlide As PowerPoint.Slide

    Set ppApp = New PowerPoint.Application

    ppApp.Visible = True
    ppApp.Activate

    Set ppPres = ppApp.presentations.Open("C:\Users\ashah\Documents\Advisory.pptx")
    Set ppSlide = ppPres.Slides(1)
    ppSlide.Shapes(7).Delete

    Call CopyAndPasteChart(ppApp, ppSlide)

    With ppSlide.Shapes(ppSlide.Shapes.Count)
       .Left = (ppPres.PageSetup.SlideWidth / 2) - (.Width / 2)
       .Top = -77
    End With
    ppApp.CommandBars.ReleaseFocus

End Sub

---

Sub CopyAndPasteChart(ppApp As PowerPoint.Application, ppSlide As PowerPoint.Slide)
    Sheet1.ChartObjects(1).Chart.ChartArea.Copy
    ppApp.CommandBars.ExecuteMso ("PasteExcelChartSourceFormatting")
End Sub

You could edit the CopyAndPasteChart Sub a bit more if you fancied to make it usable in more situations.

回答2:

I know this is a little late to the game, but I used this post to try and answer the same problem I was having. And I wanted to pay it forward when I found the solution.

Now my code is a little different because I'm creating a new slide for every chart in my excel worksheet, but I too need to keep the source formatting.

Dim PowerPointApp As Object
Dim CurrentSlide As Object
Dim PowerPointDoc As Object
Dim xChart As ChartObject
Dim wb As Workbook
Dim ws As Worksheet
Dim Chart As ChartObject
Dim Sheet As Worksheet
Dim x As Long

Set wb = ActiveWorkbook
Set ws = wb.ActiveSheet

Set PowerPointApp = CreateObject("Powerpoint.Application")
Set PowerPointDoc = PowerPointApp.Presentations.Add(msoTrue)
PowerPointApp.Visible = True

For Each Chart In ws.ChartObjects
    PowerPointApp.ActivePresentation.Slides.Add 
    PowerPointApp.ActivePresentation.Slides.count + 1, 12
    Set CurrentSlide = PowerPointDoc.Slides(PowerPointDoc.Slides.count)
    CurrentSlide.Select
    Chart.Copy
    PowerPointApp.CommandBars.ExecuteMso "PasteExcelChartSourceFormatting"

    '**********************************
    Do
        DoEvents
    Loop Until CurrentSlide.Shapes.count > 0
    '**********************************

Next Chart

The "Do While Loop" has helped avoid this error. It does take some time for the macro to finish depending on how many charts you have.

来源：https://stackoverflow.com/questions/36692962/executemso-error-after-using-it-to-post-a-chart-from-excel-to-ppt