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.
Patrick O'Beirne @ sysmod 
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.
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
That’s because you have not put in the waiting code, which is the purpose of this post.
Try
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 SubThank 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
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
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”
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
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”
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…
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
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
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!
Is there a way to adjust the font?
By the way, I have many tables in different slides.
Thanks.
All cell changes – font, size, fill colour, etc are done cell by cell.
google for powerpoint vba table cell formatting
eg
http://www.pptfaq.com/FAQ00790_Working_with_PowerPoint_tables.htm
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!
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.
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.
All the coding is below. See in particular 2015/04/24
I simply paste in sequence, if you want to paste at random then just use objpresention.Slides(index) as the target, and for the shape adjust top, left, etc as you wish.