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
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