简体   繁体   中英

VBA copying and pasting charts from excel to powerpoint

Ok, so I'm trying to write some code which will first create about 15 graphs on excel and then open a template on powerpoint and paste these graphs into each slide. I'm having multiplt issues though and I can't really seem to find out why. When I run through the code line by line by pressing f8 it works fine but the second I run the whole macro a few things happen: 1) It randomly will decide to not paste some graphs on pages 2) When trying to refer to the pasted graph via code like .shapes(3) or shapes(slide.shapes.count) I get an error message saying shapes.item: integer 3 out of range 1 to 2 3) I'm using CommandBars.ExecuteMso ("PasteSourceFormatting") to paste the graphs as I need to keep the formatting, I can paste the graphs and position them another way but it doesn't keep the formatting which I need.

Any suggestions?

Here is the code:

   Sub PowerPointPresentation()
   Dim PPT As Object
   Set PPT = CreateObject("PowerPoint.Application")
   PPT.Visible = True
   PPT.Presentations.Open filename:="P:\My Documents\CM Presentation Macro\CM Presentation Template.pptm"
'copy_chart "sheet_name", 2  ' Name of the sheet to copy graph and slide number the graph is to be pasted in

Dim PPApp As Object
Dim PPPres As Object
Dim PPSlide As Object

Set PPApp = CreateObject("Powerpoint.Application")
'Set PPSlide = CreateObject("Powerpoint.Slide")

Set PPApp = GetObject(, "Powerpoint.Application")
Set PPPres = PPApp.ActivePresentation

'Slide 1
PPApp.ActiveWindow.View.GotoSlide (1)
Set PPSlide = PPPres.Slides(PPApp.ActiveWindow.Selection.SlideRange.SlideIndex)
PPSlide.Shapes(1).TextFrame.TextRange.Text = r & " Country Review  YTD " & Year(Now())

'Slide 2
PPApp.ActiveWindow.View.GotoSlide (2)
Set PPSlide = PPPres.Slides(PPApp.ActiveWindow.Selection.SlideRange.SlideIndex)
PPSlide.Shapes(1).TextFrame.TextRange.Text = r & " Country Review  YTD " & Year(Now())

'Slide 3
Worksheets("Pivots").ChartObjects(1).Select
ActiveChart.ChartArea.Copy

i = Pivots.Range("G14").Text
j = Pivots.Range("H14").Text

PPApp.ActiveWindow.View.GotoSlide (3)
Set PPSlide = PPPres.Slides(PPApp.ActiveWindow.Selection.SlideRange.SlideIndex)
With PPSlide
.Shapes(1).TextFrame.TextRange.Text = r & " TCV YTD " & Year(Now()) - 1 & " and " & Year(Now()) & " - by Sector"
.Shapes(2).TextFrame.TextRange.Text = "Totals:" & Year(Now()) - 1 & ":" & i & "" & Year(Now()) & ":" & j
End With
PPApp.CommandBars.ExecuteMso ("PasteSourceFormatting")

'Slide 4
Worksheets("Pivots").ChartObjects(2).Select
ActiveChart.ChartArea.Copy

i = Pivots.Range("V14").Text
j = Pivots.Range("W14").Text

PPApp.ActiveWindow.View.GotoSlide (4)
Set PPSlide = PPPres.Slides(PPApp.ActiveWindow.Selection.SlideRange.SlideIndex)
With PPSlide
.Shapes(1).TextFrame.TextRange.Text = r & " TCV YTD " & Year(Now()) - 1 & " and " & Year(Now()) & " - by Type"
.Shapes(2).TextFrame.TextRange.Text = "Totals:" & Year(Now()) - 1 & ":" & i & "" & Year(Now()) & ":" & j
End With
PPApp.CommandBars.ExecuteMso ("PasteSourceFormatting")

'Slide 5
Worksheets("Pivots").Range("New_TCV_YTD2014[#All]").Copy

PPApp.ActiveWindow.View.GotoSlide (5)
Set PPSlide = PPPres.Slides(PPApp.ActiveWindow.Selection.SlideRange.SlideIndex)
With PPSlide
PPApp.CommandBars.ExecuteMso ("PasteSourceFormatting")
End With

Worksheets("Pivots").ChartObjects(3).Select
ActiveChart.ChartArea.Copy

PPApp.ActiveWindow.View.GotoSlide (5)
Set PPSlide = PPPres.Slides(PPApp.ActiveWindow.Selection.SlideRange.SlideIndex)
With PPSlide
.Shapes(1).TextFrame.TextRange.Text = r & " New TCV by AM YTD " & Year(Now())
PPApp.CommandBars.ExecuteMso ("PasteSourceFormatting")
End With

' Clean up
Set PPSlide = Nothing
Set PPPres = Nothing
Set PPApp = Nothing

End Sub

Instead of this:

PPApp.ActiveWindow.View.GotoSlide (1)
Set PPSlide = PPPres.Slides(PPApp.ActiveWindow.Selection.SlideRange.SlideIndex)

Try this:

Set PPSlide = PPPres.Slides(1)

No need to go to the slide.

When pasting a chart, try:

Dim oSh As Shape
With ActivePresentation.Slides(1)
    Set oSh = .Shapes.PasteSpecial(ppPasteOLEObject)(1)
    ' And now you can use oSh to position/size/otherwise work with the chart
End With

And you can probably do this rather than selecting anything in the workbook:

Worksheets("Pivots").ChartObjects(2).Copy

If you don't select stuff (in either app), your code will run somewhere between ten and forty-eleven bazillion times faster and will be more reliable. And that alone might solve the other problem; the app may be busy trying to refresh after the select actions you're asking for and unable to keep up with the other stuff you ask it to do next.

The technical post webpages of this site follow the CC BY-SA 4.0 protocol. If you need to reprint, please indicate the site URL or the original address.Any question please contact:yoyou2525@163.com.

 
粤ICP备18138465号  © 2020-2024 STACKOOM.COM