Excel VBA Copy Range, Paste as Table to Powerpoint 2010/2013

So, I’ve spent the last couple of weeks trying to get that one right.

Piecing together all the hints from stackoverflow and the rest, I find that I have to use the ExecuteMso method available in PP2010 and later, and use Doevents to give PP time to act in order to avoid raising errors.

In this code, mPPAppObject is the Powerpoint Application object accessed from Excel VBA eg Set mPPAppObject = GetObject(, "PowerPoint.Application")

Assuming we start with rng.Copy then if the paste is to be a table then

for i=1 to 500:Doevents :next ' 5 hundred, about 10ms timing

‘Otherwise get a Clipboard Error -2147188160 Shapes (unknown member) : Invalid request.  Clipboard is empty or contains data which may not be pasted here.

mPPAppObject.CommandBars.ExecuteMso "PasteExcelTableSourceFormatting" ' 2010+

mPPAppObject.CommandBars.ReleaseFocus

for i=1 to 5000:Doevents :next ' 5 thousand, about 100ms
‘Otherwise calling code testing the slide.shapes collection does not see the pasted shape yet, or it does not see that the shape has a table (oShape.HasTable)

Set oShape = mPPSlide.Shapes(mPPSlide.Shapes.Count)

If we want some other paste format, then it’s a bit easier:

Set oShape = mPPSlide.Shapes.PasteSpecial(PasteDataType)

‘Where PasteDataType can be

‘ 0 ppPasteDefault ‘ truncates to correspond to visible on worksheet window
‘ 2 ppPasteEnhancedMetafile pastes correctly with full width
‘ 3 ppPasteMetafilePicture ‘ same as default, *truncated if too wide*

‘ 7 ppPasteText
‘ 8 ppPasteHTML ‘ does not work, use mPPAppObject.ActiveWindow.View.Paste

In PP 2013 I sometimes found that more than one shape would be pasted, so:

' oShape.Count property does not exist for correctly pasted shape. So use errtrapped function
If ObjectCount(oShape) > 1 Then ' handle pp 2013 bug
'Debug.Print ">1 shape pasted: "; TypeName(oShape); oShape.Count ' ShapeRange 2
Set oShape = oShape(1)
End If

Function ObjectCount(obj As Object) As Long
If obj Is Nothing Then
ObjectCount = 0
Else
ObjectCount = 1
On Error Resume Next
ObjectCount = obj.Count
'could do Err.Clear here if you like
End If
End Function

What a kludge to get something done that should be easily accessible from the COM model.

Advertisements

About Patrick O'Beirne, spreadsheet auditor

Patrick provides consultancy and training in spreadsheet development, auditing / testing and model review; and the Excel addin XLtest
This entry was posted in Uncategorized and tagged , , , , . Bookmark the permalink.

22 Responses to Excel VBA Copy Range, Paste as Table to Powerpoint 2010/2013

  1. arthur says:

    Patrick,

    What if I want to do this multiple times in different slides?

    • Well… just do it as often as you need, starting from “assuming you start from rng.copy….”
      Did you mean something else?
      BTW since then I’ve improved performance by using Sleep along DoEvents, I must post that soon.

      • arthur says:

        Patrick,

        First of all thank you very much for your reply.

        I tried the following code to copy a table from excel and paste to 5 different slides, but it doesn’t seem to work. It only pastes the table to the first slide.

        For x 1 to 5

        myPresentation,Slides(x).select

        rng.copy

        PowerPointApp.CommandBars.ExecuteMso “PasteExcelTableSourceFormatting”
        PowerPointApp.CommandBars.ReleaseFocus

        Next x

  2. That’s because you have not put in the waiting code, which is the purpose of this post.
    Try

    For x = 1 to 5
    myPresentation,Slides(x).select
    For i = 1 To 50000: DoEvents: Next ' give PP time to select
    
    rng.copy
    For i = 1 To 50000: DoEvents: Next ' give Excel time to fill clipboard
    
    PowerPointApp.CommandBars.ExecuteMso “PasteExcelTableSourceFormatting”
    PowerPointApp.CommandBars.ReleaseFocus
    For i = 1 To 50000: DoEvents: Next ' give PP time to paste
    
    Next x
    
    • arthur says:

      Thank you for the attention, but it still doens’t work. Here is the full code:

      Sub PastetoSlides()

      Dim myPresentation As PowerPoint.Presentation
      Dim PowerPointApp As PowerPoint.Application
      Dim x As Long

      Set PowerPointApp = GetObject(class:=”PowerPoint.Application”)
      Set myPresentation = PowerPointApp.ActivePresentation

      For x = 1 To 5
      myPresentation.Slides(x).Select
      For i = 1 To 50000: DoEvents: Next

      Sheets(“sheetname”).range(“d11:i14”).Copy

      For i = 1 To 50000: DoEvents: Next

      PowerPointApp.CommandBars.ExecuteMso “PasteExcelTableSourceFormatting”
      PowerPointApp.CommandBars.ReleaseFocus

      For i = 1 To 50000: DoEvents: Next

      Next x

      Application.CutCopyMode = False
      ThisWorkbook.Activate
      MsgBox “Complete!”

      End Sub

      It runs for about 10 seconds than returns “Invalid procedure call or argument” for
      PowerPointApp.CommandBars.ExecuteMso “PasteExcelTableSourceFormatting”

      Thank you for your help.

      • That code works for me. I start with an empty Book1 and insert a module with that code, and PP is open with 5 blank slides ready. You may need to tweak the time it waits.
        Here is an enhancement that might be easier to read:

        Option Explicit
        Declare Function GetTickCount Lib "kernel32" () As Long ' #visible
        Declare Sub Sleep Lib "kernel32" (ByVal lngMilliSeconds As Long)
        
        Sub PastetoSlides()
        
        Dim myPresentation As Object ' PowerPoint.Presentation
        Dim PowerPointApp As Object  ' PowerPoint.Application
        Dim x As Long, i As Long
        
        Set PowerPointApp = GetObject(class:="PowerPoint.Application")
        Set myPresentation = PowerPointApp.ActivePresentation
        Application.Cursor = xlWait
        For x = 1 To 5
        Application.StatusBar = "Slide " & x
        myPresentation.Slides(x).Select
        WaitmSecs 100
        
        Sheets("sheetname").Range("d11:i14").Copy
        
        WaitmSecs 100
        Application.StatusBar = "Paste "
        PowerPointApp.CommandBars.ExecuteMso "PasteExcelTableSourceFormatting"
        PowerPointApp.CommandBars.ReleaseFocus
        
        WaitmSecs 1000
        
        Next x
        Application.Cursor = xlDefault
        Application.CutCopyMode = False
        ThisWorkbook.Activate
        MsgBox "Complete!"
        
        End Sub
        
        'http://www.cpearson.com/excel/WaitFunctions.aspx
        'http://www.vbaexpress.com/forum/showthread.php?46243-Solved-Retain-Excel-Format-when-pasting-to-PowerPoint
        Sub WaitmSecs(mSecs As Long)
           Dim lmsStart As Long, i As Long
           lmsStart = GetTickCount()
           ' 4.50 Sleep alone won't do for Powerpoint, need doevents for PP to catch up.
           Do While GetTickCount() < lmsStart + mSecs
              i = i + 1
              Sleep 1 ' doing this reduces CPU usage from 55% to 5%
              DoEvents
           Loop
        End Sub
        
        
  3. arthur says:

    Thank you Patrick.

    It works for me now.

    But what if I want to paste different tables to multiple slides?

    Fof example, for slide 1 I want to paste Sheets(“sheetname”).Range(“d11:i14”).Copy, for slide 2 i want to paste sheets(“sheetname2”).Range(“d16:i18”).Copy

    I tried the folowinf but it didn’t work.

    dim range1 as string
    dim range2 as string
    dim range3 as string
    dim range4 as string
    dim range5 as string

    set range1 = Sheets(“sheetname”).Range(“x10”). value ‘Which returns (“d11:i14”)

    for x = 1 to 5

    Sheets(“sheetname”).Range(“range” & x).copy ‘I thought that when the x change tha range to copy would change as well

  4. Sheets(“sheetname”).Range(“range” & x).copy
    That would work IF you had defined range names range1, range2, etc on the sheet named “sheetname”. Have you?
    If not, then you have different sheets, and different ranges, so I don’t see the consistency that a loop would imply so do them individually. Write a sub to copy & paste a range as above, then call that sub passing in the range and slide you want.

    take out the “For x = 1 To 5” and use
    pastetoslide Sheets(“sheetname”).range(“d14:i14”), 1
    pastetoslide Sheets(“sheetname2”).range(“d16:i18”), 2
    …etc…

    Sub pastetoslide(rg as range, iSlide as long)
    Application.StatusBar = “Slide ” & islide
    myPresentation.Slides(iSlide).Select ‘ or, add a slide if you want a new one
    WaitmSecs 100
    rg.Copy
    WaitmSecs 100
    Application.StatusBar = “Paste ”
    PowerPointApp.CommandBars.ExecuteMso “PasteExcelTableSourceFormatting”
    PowerPointApp.CommandBars.ReleaseFocus
    WaitmSecs 1000 ‘ or 2000 or whatever works
    end sub

  5. Pelle says:

    Thanks a lot – been struggling for some of hours to understand why the Excel table appeared as text when pasting into Powerpoint using CommandBars.ExecuteMso “PasteExcelTableSourceFormatting”

  6. arthur says:

    Thanks a lot, Patrick. My code works like a charm now.

    Would you happen to know if there is anyway we can reposition the table we just pasted to powerpoint?

    • Sure. Just start with the shape just pasted
      Set ppsShp = mPPSlide.Shapes(mPPSlide.Shapes.Count)
      and then adjust its size and position eg

      Sub FitWHMAndCentreShape(ByRef oShape As Object, nMaxPictPXWidth As Single, nMaxPictPXHeight As Single, nTopMargin As Single) ' fits shape; could be Excel.shape or Powerpoint.shape
      ' if the picture W:H ratio is greater than the slide W:H then we need to fit the width, else fit the height
      If oShape Is Nothing Then
      Exit Sub
      End If
      oShape.LockAspectRatio = True ' shape autoscales when one dimension is changed
      If oShape.width / oShape.Height > nMaxPictPXWidth / nMaxPictPXHeight Then
      ' Width is limiting dimension
      oShape.width = nMaxPictPXWidth
      Else
      ' Height is limiting dimension
      oShape.Height = nMaxPictPXHeight
      End If
      CentreShape oShape, nTopMargin
      End Sub

      Sub CentreShape(ByRef oShape As Object, nTopMargin As Single) ' fits shape; could be Excel.shape or Powerpoint.shape
      If Not oShape Is Nothing Then
      oShape.Left = (mPPPres.PageSetup.SlideWidth - oShape.width) / 2 ' centered horizontally
      oShape.Top = nTopMargin + (mPPPres.PageSetup.SlideHeight - nTopMargin - oShape.Height) / 2 ' centred vertically under any title
      End If
      End Sub

  7. arthur says:

    I tried

    dim oShape as object
    dim myPresentation as object

    Set oShape = myPresentation.Slides.Shapes(myPresentation.Slides.Shapes.Count)
    oShape.Top = 130
    oShape.Left = 100

    But it returns “object doesn’t support this property or method”

  8. Yes, you have not said which slide from the presentation.
    And your multiple-level object chain means you don’t know which object the error message refers to.
    To make debugging easier, I strongly recommend you break multiple steps into simple ones.
    set myPresentation=PowerpointAppObject.activepresentation
    Set oSlide=myPresentation.Slides(myPresentation.Slides.count) ‘ or whichever slide you want
    set oShape=oSlide.shapes(oSlide.shapes.count)
    …etc…

    • arthur says:

      Thank you very much!! It’s working fine now

      With myPresentation.PageSetup

      Set oShape = myPresentation.Slides(x).Shapes(myPresentation.Slides(x).Shapes.Count)
      oShape.Top = 93
      oShape.Left = (.SlideWidth \ 2) – (oShape.Width \ 2)

      End With

  9. arthur says:

    Patrick,

    I can’t thank you enough for the help with this code.

    One last question though..Sometimes I run the code and it works perfectly, but sometimes it returns an error on the following line:

    PowerPointApp.CommandBars.ExecuteMso “PasteExcelTableSourceFormatting”

    Whenever this happens I just stop the debugger and try again and it works normally.

    Do you have any idea why this could be happening?

    Thanks

  10. As I see it, Powerpoint is not ready; it has not finished rendering the previous slide.
    I now use a loop to try that paste, and wait in a loop of Doevents : Sleep 1 for a maximum of 10 seconds for the table to appear. That is, if the shapes count has increased and oShape.HasTable is True.
    If that fails, I retry both the copy (some keyboard action by the user might have cleared the clipboard) and paste. If that fails ten times, I ask the user what they want to do – try again or proceed. If the PP app object goes out of scope, PP may have crashed, so the only thing to do is close and restart.
    Lots of errors to happen and to handle!

  11. Jue says:

    Is there a way to adjust the font?
    By the way, I have many tables in different slides.

    Thanks.

  12. Mike Guber says:

    Thanks so much for this. I’ve been banging my head against this wall for a couple of days.

    I have multiple slides in my presentation, so I actually used your wait 100ms code after selecting my slide that I want to paste into in order to make sure the table pastes into the correct slide:

    DataSheet.Range(“YearlySupport”).Copy

    ‘select latest slide so that we’re pasting into it
    PPSlide.Select

    ‘wait 100ms
    For pauseTime = 1 To 5000: DoEvents: Next ‘ 5 thousand, about 100ms

    ‘use the PowerPoint command bars to paste because pasting directly causes errors
    PPApp.CommandBars.ExecuteMso “PasteExcelTableSourceFormatting” ‘ 2010+

    ‘stop using command bars
    PPApp.CommandBars.ReleaseFocus

    ‘wait 100ms
    For pauseTime = 1 To 5000: DoEvents: Next ‘ 5 thousand, about 100ms

    Thanks again!

  13. Mark P says:

    Thank you so much for sharing this – as I’ve been struggling with this for weeks. Now with your code my Macro is finally working as it should be.

  14. L says:

    Patrick, may I know the full coding? And is it possible to use vba to paste data in specific range from excel to specific slides with specific position in ppt? Thanks.

Leave a Reply

Fill in your details below or click an icon to log in:

WordPress.com Logo

You are commenting using your WordPress.com account. Log Out / Change )

Twitter picture

You are commenting using your Twitter account. Log Out / Change )

Facebook photo

You are commenting using your Facebook account. Log Out / Change )

Google+ photo

You are commenting using your Google+ account. Log Out / Change )

Connecting to %s