Pasting and Resizing an Excel Range into Powerpoint using VBA

[spartanexcel]

Hello,
I've searched several forums and have been unable to come up with a solution this problem.

Typically when I bring Excel data (charts or cell ranges) I use Enhanced MetaFiles. They seem to keep the powerpoint file small in size, and maintains formatting. I can also adjust the size of the object once it's pasted into Powerpoint.

I now I have need to do manipulate excel filters and then copy/pastespecial the range to powerpoint using VBA.

I've been able to paste the graphic as an Enhanced Metafile using the following line, where PPSlide is a slide:
PPSlide.Application.ActiveWindow.View.PasteSpecial DataType:=ppPasteEnhancedMetafile

What I'm trying to do is paste the metafile into a Shape variable, so I can reference the variable to position and size the object properly. It seems that I'm pasting as a ShapeRange or Range object, so .Width, .Height, .Left, and .Top all create errors.

Any thoughts on how to paste an excel range into excel using Enhanced Metafile, with the ability to size/position it?

Using Office 2013. Powerpoint Macro recorder is unavailable.
Thanks.

 

[Chris Macro]

When accessing the dimensions (width, height, etc...), I use the selection.Shape to get down to those levels. Since whatever is pasted into PowerPoint is by default the selected object. I have a few macros you may find helpful in my PowerPoint Code Vault. Also make sure you unlock the aspect ratio, as if it is turned on it will adjust the width automatically when you adjust the height and it won't size properly. If that doesn't help, post your VBA code and I'm sure I can help you out.

 

[spartanexcel]

Thanks for the reply.
I checked your Powerpoint vault, but all the links give an error message.

I tried to use Application.Selection.Shape.Width = ..... and received Run-time error 438: Object doesn't support this property or method.

Here's the code from the time I copy the Excel data to the time I get the error. I also included the original "With" statement that I was planning on using (REM'd out to assist with troubleshooting).

Thanks again for the help!

Dim PpApp As PowerPoint.Application
Dim PpPres As PowerPoint.Presentation
Dim PPSlide As PowerPoint.Slide
Dim EMF As Shape
Dim i As Integer
Dim Width, Height, OWidth, OHeight As Integer

With ThisWorkbook
' Copy Tile Chart

Sheets("Tile Chart").Range("C2:AC25").Copy
End With


' Create instance of PowerPoint
Set PpApp = CreateObject("Powerpoint.Application")
PpApp.Visible = True
' Create a presentation
Set PpPres = PpApp.Presentations.Add
PpApp.ActiveWindow.ViewType = ppViewSlide
' Add first slide to presentation
Set PPSlide = PpPres.Slides.Add(1, ppLayoutTitleOnly)
PPSlide.Application.ActiveWindow.View.PasteSpecial DataType:=ppPasteEnhancedMetafile
Selection.Shape.Width = 1000
'With Selection
' ' Determine original sizes
' OWidth = .Width
' OHeight = .Height
' ' Calculate scaling for 12.5" wide
' Width = 12.5 * 72
' Height = OHeight * (Width / OWidth)
' ' Set position:
' .Left = 100
' .Top = 100
' ' Set size:
' .Shape.Height = 100
' .Shape.Width = 200
'End With

 

[spartanexcel]

I was able to get it to work.... I needed to reference Shapes(2) to get it to work.

Here's the revised With statement:
With PPSlide.Shapes(2)
' Determine original sizes
OWidth = .Width
OHeight = .Height
' Calculate scaling for 12.5" wide
Height = 5.5 * 72
Width = OWidth * (Height / OHeight)
' Set position:
.Left = 100
.Top = 100
' Set size:
.Height = Height
.Width = Width
End With

 

[Chris Macro]

Sorry it took so long for me to reply. See if this works on your end. It might be a little safer than referencing the shape number.

<font face=Calibri><SPAN style="color:#00007F">Sub</SPAN> CopyRangeToSlide()<br><br><SPAN style="color:#007F00">'Create instance of PowerPoint</SPAN><br>  <SPAN style="color:#00007F">Set</SPAN> PpApp = CreateObject("Powerpoint.Application")<br>  PpApp.Visible = <SPAN style="color:#00007F">True</SPAN><br>  PpApp.Activate<br><br><SPAN style="color:#007F00">'Create a presentation</SPAN><br>  <SPAN style="color:#00007F">Set</SPAN> PpPres = PpApp.Presentations.Add<br>  PpApp.ActiveWindow.ViewType = ppViewSlide<br>  PpApp.ActiveWindow.Panes(2).Activate<br><br><SPAN style="color:#007F00">'Add first slide to presentation</SPAN><br>  <SPAN style="color:#00007F">Set</SPAN> PPSlide = PpPres.Slides.Add(1, ppLayoutTitleOnly)<br><br><SPAN style="color:#007F00">'Copy Range</SPAN><br>  <SPAN style="color:#00007F">Set</SPAN> Rng = ThisWorkbook.Sheets("Tile Chart").Range("C2:AC25")<br><br><SPAN style="color:#007F00">'Copy Object</SPAN><br>  Rng.Copy<br><br><SPAN style="color:#007F00">'Paste to PowerPoint and position</SPAN><br>  <SPAN style="color:#00007F">Set</SPAN> myShapeRange = PPSlide.Shapes.PasteSpecial(DataType:=ppPasteEnhancedMetafile)<br><br>    <SPAN style="color:#00007F">With</SPAN> myShapeRange<br>      .LockAspectRatio = 1  <SPAN style="color:#007F00">'0 = false</SPAN><br>      .Width = 1000<br>    <SPAN style="color:#007F00">'Determine original sizes</SPAN><br>      OWidth = .Width<br>      OHeight = .Height<br>    <SPAN style="color:#007F00">'Calculate scaling for 12.5" wide</SPAN><br>      Width = 12.5 * 72<br>      Height = OHeight * (Width / OWidth)<br>    <SPAN style="color:#007F00">'Set position:</SPAN><br>      .Left = 100<br>      .Top = 100<br>    <SPAN style="color:#007F00">'Set size:</SPAN><br>      .LockAspectRatio = 0<br>      .Height = 100<br>      .Width = 200<br>    <SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">With</SPAN><br><br><SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">Sub</SPAN><br></FONT>

 

[spartanexcel]

Hi Chris,
I'll give that a try... but since I can assign a variable to the shape.......

Do you know how to assign the Metafile to an array, like MyShapeRange(i,j,k) without actually pasting?

I'm trying to grab data for a 60 slide powerpoint deck. I could grab them one at a time, bouncing between Excel and Powerpoint, but it might be easier if I could grab all 60 from Excel and assign them to that array, then paste them when I switch over the PowerPoint.

 

[Chris Macro]

I'm not sure if that's possible...I've always just bounced back and forth from Excel and PowerPoint. It will run faster if you turn off screen updating. Just add this line at the beginning of your code: Application.ScreenUpdating = False

 

[spartanexcel]

Your suggestion works great Chris... thanks for the help.

 

[Chris Macro]

Any time!

 

[vashon2kool]

Hi Chris,

On the same topic, do you know of a way to turn off autofit on PowerPoint using VBA? I would like to copy and paste from excel to PowerPoint as is. Thanks.