PDA

View Full Version : How do I paste an array of predefined ranges from excel into powerpoint as embed/link



NagamiKai
05-25-2017, 07:40 PM
I've tried mishmashing different codes with similar features on the internet to produce the desired effect however with predefined ranges in an array, I realize that the range doesn't get pasted as embed/linked.


I'm trying to have one range per slide in a new powerpoint slide for easier reporting. So far the codes do paste all the ranges into a new ppt with 1 range per slide but it does not paste it as embed. Is there any way in which I could solve this issue?



Sub ExcelRangeToPowerPoint()
'PURPOSE: Copy/Paste An Excel Range Into a New PowerPoint Presentation


Dim rng As Range
Dim PowerPointApp As Object
Dim myPresentation As Object
Dim mySlide As Object
Dim myShape As Object
Dim MyRangeArray As Variant
Dim oPPTApp As PowerPoint.Application
Dim x As Long


MyRangeArray = _
Array( _
Sheets("All DDR").Range("A3:J11"), Sheets("All DDR").Range("A13:J21"),
Sheets("All DDR").Range("A23:J31"), _
Sheets("All DDR").Range("A33:J41"), Sheets("All DDR").Range("A43:J51"),
Sheets("All DDR").Range("A53:J61"), _
Sheets("All DDR").Range("A63:J71"), Sheets("All DDR").Range("A73:J81"),
Sheets("All DDR").Range("A83:J91"), _
Sheets("All DDR").Range("A93:J101"), Sheets("All
DDR").Range("A103:J111"), _
_
Sheets("TNR DDR").Range("A3:J11"), Sheets("TNR DDR").Range("A13:J21"),
Sheets("TNR DDR").Range("A23:J31"), _
Sheets("TNR DDR").Range("A33:J41"), Sheets("TNR DDR").Range("A43:J51"),
Sheets("TNR DDR").Range("A53:J61"), _
Sheets("TNR DDR").Range("A63:J71"), Sheets("TNR DDR").Range("A73:J81"),
Sheets("TNR DDR").Range("A83:J91"), _
Sheets("TNR DDR").Range("A93:J101"), Sheets("TNR
DDR").Range("A103:J111"), _
_
Sheets("BE2 DDR").Range("A3:J11"), Sheets("BE2 DDR").Range("A13:J21"),
Sheets("BE2 DDR").Range("A23:J31"), _
Sheets("BE2 DDR").Range("A33:J41"), Sheets("BE2 DDR").Range("A43:J51"),
Sheets("BE2 DDR").Range("A53:J61"), _
Sheets("BE2 DDR").Range("A63:J71"), Sheets("BE2 DDR").Range("A73:J81"),
Sheets("BE2 DDR").Range("A83:J91"), _
Sheets("BE2 DDR").Range("A93:J101"), Sheets("BE2
DDR").Range("A103:J111"), _
_
Sheets("FE+BE1 DDR").Range("A3:J11"), Sheets("FE+BE1
DDR").Range("A13:J21"), Sheets("FE+BE1 DDR").Range("A23:J31"), _
Sheets("FE+BE1 DDR").Range("A33:J41"), Sheets("FE+BE1
DDR").Range("A43:J51"), Sheets("FE+BE1 DDR").Range("A53:J61"), _
Sheets("FE+BE1 DDR").Range("A63:J71"), Sheets("FE+BE1
DDR").Range("A73:J81"), Sheets("FE+BE1 DDR").Range("A83:J91"), _
Sheets("FE+BE1 DDR").Range("A93:J101"), Sheets("FE+BE1
DDR").Range("A103:J111") _
)


'Create an Instance of PowerPoint
On Error Resume Next

'Is PowerPoint already opened?
Set PowerPointApp = GetObject(class:="PowerPoint.Application")

'Clear the error between errors
Err.Clear


'If PowerPoint is not already open then open PowerPoint
If PowerPointApp Is Nothing Then Set PowerPointApp =
CreateObject(class:="PowerPoint.Application")

'Handle if the PowerPoint Application is not found
If Err.Number = 429 Then
MsgBox "PowerPoint could not be found, aborting."
Exit Sub
End If


On Error GoTo 0


'Optimize Code
Application.ScreenUpdating = False

'Create a New Presentation
Set myPresentation = PowerPointApp.Presentations.Add


'Copy Range from Excel
For x = 0 To 43
Set rng = MyRangeArray(x)
'Add a slide to the Presentation
Set mySlide = myPresentation.Slides.Add(1, 11) '11 = ppLayoutTitleOnly


'Copy Excel Range


rng.Copy


'Paste to PowerPoint and position
mySlide.Shapes.PasteSpecial (Link = True)
Set myShape = mySlide.Shapes(mySlide.Shapes.Count)

'Set position:
myShape.Left = 66
myShape.Top = 152

'Make PowerPoint Visible and Active
PowerPointApp.Visible = True
PowerPointApp.Activate


'Clear The Clipboard
Application.CutCopyMode = False
Next

End Sub

rlv
05-25-2017, 10:40 PM
Cross-posted:

https://www.mrexcel.com/forum/excel-questions/1007054-how-do-i-paste-array-predefined-ranges-excel-into-powerpoint-embed-link.html

mdmackillop
05-26-2017, 07:53 AM
Missing colon

mySlide.Shapes.PasteSpecial (Link:= True)

NagamiKai
05-28-2017, 05:05 PM
When I try your suggestion, I get the error : " Expected a ="

I'm not sure why, however Ive found a working solution to my problem too.







Instead of :
'Paste to PowerPoint and position
mySlide.Shapes.PasteSpecial (Link =True)
Set myShape = mySlide.Shapes(mySlide.Shapes.Count)

Try this to get a linked Excel object in PPT:
Set myShape = mySlide.Shapes.PasteSpecial(0,False,,,,True)(1)

mdmackillop
05-29-2017, 07:53 AM
Hi
In this question (http://www.vbaexpress.com/forum/showthread.php?59499-Macro-for-copying-flexible-ranges-as-pictures-to-PPT&p=361516&viewfull=1#post361516) the data type was changed as appropriate as suggested by the code originator.
Changing this line to include the link worked in my tests. In Post #3 above, I'd try removing the brackets


mySlide.Shapes.PasteSpecial DataType:=6 Link:= True '6= ppPastePNG