Solved: Retain Excel Format when pasting to PowerPoint

[mantooth29]

Ok so I know there are at least a handful of issues when copying-pasting from Excel to PowerPoint when you have different versions of office suite.

I had a couple of subs that used .PasteSpecial pptPasteDefault to get a formatted range of cells into powerpoint, while retaining the editability of the range in powerpoint. Needless to say, everything worked fine when we were all running Office 2003.

Now we are starting to migrate to 2010, and lo and behold pastedefault is broken. I have seen this question asked in a few places, and it seems that to get a range of cells into PowerPoint as an editable table you need to use Windows(i).Views.PasteSpecial ppPasteDefault as opposed to Slides(i).Shapes.PasteSpecial ppPasteDefault

This DOES get you an editable, unlinked table in PowerPoint... but does NOT retain any formatting. As a user, its very simple to do pastespecial - retain source formatting.

How can I accomplish this programatically?

To be clear, the powerpoint "table" is not meant to be linked. It just needs to be a copy of an Excel range which is editable in PowerPoint.

Here is the function I use. What change do I need to make to retain the formatting?

Private Function CreateTable(RangeAdded As Excel.Range, PptPresentation As PowerPoint.Presentation, _
SlideNumber As Long, ShapeName As String) As PowerPoint.Shape

RangeAdded.Copy

With PptPresentation

.Slides(SlideNumber).Select
.Windows(1).View.PasteSpecial ppPasteDefault
.Slides(SlideNumber).Shapes(.Slides(SlideNumber).Shapes.Count).Name = ShapeName
Set CreateTable = .Slides(SlideNumber).Shapes(ShapeName)

End With

Application.CutCopyMode = False

End Function

Any help is greatly appreciated!

[John Wilson]

Does something based on this work??

Sub paste_toPPT()
Dim pptApp As PowerPoint.Application
Dim pptPres As PowerPoint.Presentation
Dim myRange As Excel.Range
Set myRange = ActiveSheet.Range("F6:F8")
Set pptApp = GetObject(Class:="PowerPoint.Application")
Set pptPres = pptApp.ActivePresentation
myRange.Copy
pptPres.Windows(1).Activate
pptPres.Windows(1).View.GotoSlide 3
pptApp.CommandBars.ExecuteMso ("PasteSourceFormatting")
End Sub

Note PasteSourceFormatting is new in 2010

[mantooth29]

Thank you very much for the reply. I had seen this posted as a suggestion, but was not sure how to implement.

Unfortunately, I receive an Object/With variable not set error on the line
pptPres.Windows(1).Commandbars.ExecuteMso("PasteSourceFormatting")
I am googling around to see what is causing that.

[John Wilson]

My code assumes that the PowerPoint Presentation is open and there are at least three slides. Is it and are there? Works OK here.

[John Wilson]

Hang on

The line should be
pptApp.Commandbars.ExecuteMso("PasteSourceFormatting")

I corrected this too if you are reading by email!

[mantooth29]

Yes it is. The procedure opens a blank presentation with 4 slides preloaded.
It is already set up to copy a variety of ranges, most of them as enhanced metafiles which have continued to work fine.

The GotoSlide command works as well, as I can see it moves to slide 2.

I also saved both the Excel File and Powerpoint in 2010 format to count out any cross version complications.

Would the use of early binding as opposed to CreateObject impact this? I will test to see if that resolves the issue..

[mantooth29]

Ok now I get Method 'ExecuteMso' of object '_CommandBars' failed

[John Wilson]

Are you using

pptApp.Commandbars.ExecuteMso("PasteSourceFormatting")

[John Wilson]

can you just try my exact code with a three + slide presentation open and something in the Excel range. Let's see if that works for you first and then maybe post all your code.

Sub paste_toPPT()
Dim pptApp As PowerPoint.Application
Dim pptPres As PowerPoint.Presentation
Dim myRange As Excel.Range
Set myRange = ActiveSheet.Range("F6:F8")
Set pptApp = GetObject(Class:="PowerPoint.Application")
Set pptPres = pptApp.ActivePresentation
myRange.Copy
pptPres.Windows(1).Activate
pptPres.Windows(1).View.GotoSlide 3
pptApp.CommandBars.ExecuteMso ("PasteSourceFormatting")
End Sub

[mantooth29]

Hat in hand your code as posted works fine. Unfortunately I'm hitting a snag when incorporating it into my program flow. I am posting my code below.


Sub Main()

Dim pptApp As PowerPoint.Application
Dim pres As PowerPoint.Presentation
Dim myShape As PowerPoint.Shape

Dim wb As Excel.Workbook
Dim myRange As Excel.Range
Dim summarySheet As Excel.Worksheet, pricingSheet As Excel.Worksheet

Set pptApp = New PowerPoint.Application
Set pres = pptApp.Presentations.Open(SLIDEPATH)

Set wb = ActiveWorkbook
Set summarySheet = wb.Worksheets("Sheet1")

Set myRange = pricingSheet.Range("MyNamedRange")
Set myShape = CreateTable(RangeAdded:=myRange, PptPresentation:=pres, _
SlideNumber:=3, ShapeName:="My Range")

End Sub


And the helper function...(with remnants of old attempts)


Private Function CreateTable(RangeAdded As Excel.Range, PptPresentation As PowerPoint.Presentation, _
SlideNumber As Long, ShapeName As String) As PowerPoint.Shape

Dim localApp As PowerPoint.Application
Set localApp = PptPresentation.Application

With PptPresentation

.Windows(1).Activate
.Windows(1).View.GotoSlide SlideNumber
'localApp.CommandBars.ExecuteMso ("PasteSourceFormatting")
.Application.CommandBars.ExecuteMso ("PasteSourceFormatting")
'.Slides(SlideNumber).Select
'.Windows(1).View.PasteSpecial ppPasteDefault
.Slides(SlideNumber).Shapes(.Slides(SlideNumber).Shapes.Count).Name = ShapeName
Set CreateTable = .Slides(SlideNumber).Shapes(ShapeName)

End With

Application.CutCopyMode = False

End Function

[mantooth29]

I just realized at some point I edited out the RangeAdded.Copy to pass to the clipboard. This was what produced the error...
However, the content in my version is only pasted properly when stepping through the macro. If I just run it the content never gets pasted to slide.

I am going to experiment with Application.OnTime now..
This has been a long day!

[mantooth29]

Turns out that I had to add a DoEvents loop to give the OS time to process the heavy formatting on the relatively large range of cells being copied over. Also, releasing focus on the command bar upon execution seems to smooth out subsequent calls.

For those who are interested, here is my working function in all its hideous glory. And of course a big thanks to John for pointing out the correct method!


Private Function CreateTable(RangeAdded As Excel.Range, PptPresentation As PowerPoint.Presentation, _
SlideNumber As Long, ShapeName As String) As PowerPoint.Shape

Dim localApp As PowerPoint.Application
Set localApp = GetObject(Class:="PowerPoint.Application")

RangeAdded.Copy
With PptPresentation
.Windows(1).Activate
.Windows(1).View.GotoSlide SlideNumber
localApp.CommandBars.ExecuteMso ("PasteSourceFormatting")
Dim l As Long
For l = 1 To 100
DoEvents
Next l
localApp.CommandBars.ReleaseFocus
.Slides(SlideNumber).Shapes(.Slides(SlideNumber).Shapes.Count).Name = ShapeName
Set CreateTable = .Slides(SlideNumber).Shapes(ShapeName)
End With

Application.CutCopyMode = False

End Function

[John Wilson]

Came up with something similar

What's happening is the CutCopyMode is being set to false BEFORE the paste happens. Can you not just remove that line or is it important.

[mantooth29]

Thanks for isolating that John. I have confirmed that the Application.cutcopymode = False is the source of the problem. I guess the Application object can get ahead of itself...

However, the clipboard cleanup seems to be important, as this function gets subsequent calls and will occasionally retain the old range and paste it twice.

So for that reason, I have to stick with the DoEvents workaround for now... :dunno

Thanks again! :friends: