To take an Excel range and paste it into a PowerPoint Application, requires breaking down the process into a few different parts. Looking at your code, we can break it down to the following components:
- Create an instance of PowerPoint.
- Create your slide & presentation.
- Create a reference to the range you want to export & then copy it.
- Align the shape to the desired dimensions.
- Finally, release your objects from memory.
I am assuming that you want this code left as late-binding, but there are also sections of your code that will cause issues because you are treating it like it was written in early-binding.
Also, I have a YouTube video on this topic, so feel free to watch the series if you want to do a more complicated paste or if you're working with multiple Excel Ranges.
Link to Playlist:
https://www.youtube.com/playlist?list=PLcFcktZ0wnNlFcSydYb8bI1AclQ4I38VN
SECTION ONE: DECLARE THE VARIABLES
Here we will just create all the variables we need in our script.
'Declare PowerPoint Variables
Dim PPTApp As Object
Dim PPTPres As Object
Dim PPTSlide As Object
'Dim Excel Variables
Dim ExcRng As Range
SECTION TWO: CREATE A NEW INSTANCE OF POWERPOINT
This will create a new PowerPoint application, make it visible and make it the active window.
'Create a new PowerPoint Application and make it visible.
Set PPTApp = CreateObject("PowerPoint.Application")
PPTApp.Visible = True
PPTApp.Activate
SECTION THREE: CREATE A NEW PRESENTATION & SLIDE
This will add a new presentation to the PowerPoint Application, create a new slide in the presentation and set the layout as a blank layout.
'Create a new Presentation
Set PPTPres = PPTApp.Presentations.Add
'Create a new Slide
Set PPTSlide = PPTPres.Slides.Add(1, 12) '<<< THIS 12 MEANS A BLANK LAYOUT.
SECTION FOUR: CREATE A REFERENCE TO THE EXCEL RANGE & COPY IT
This will set a reference to our Excel range we want to copy and copy it.
'Set a reference to the range
Set ExcRng = Range("B1:J31")
'Copy Range
ExcRng.Copy
SECTION FOUR: PASTE IN SLIDE AS OLEOBJECT
This will paste the range in the slide and set a reference to it.
'Paste the range in the slide
SET PPTShape = PPTSlide.Shapes.PasteSpecial(10) '<<< 10 means OLEOBJECT
SECTION FIVE: ALIGN THE SHAPE
This will select the shape and set the dimensions of it.
'Select the shape.
PPTSlide.Shapes(PPTSlide.Shapes.Count).Select
'Set the Dimensions of the shape.
With PPTApp.ActiveWindow.Selection.ShapeRange
.Top = 65
.Left = 7.2
.Width = 700
End With
SECTION SIX: RELEASE OBJECTS FROM MEMORY
This will release the objects from memory.
'Erase Objects from memory.
Set PPTApp = Nothing
Set PPTSlide = Nothing
Set PPTShape = Nothing
In full, this is how your code will now look:
Sub ExportRangeToPowerPoint_Late()
Dim PPTApp As Object
Dim PPTPres As Object
Dim PPTSlide As Object
Dim PPTShape As Object
Dim ExcRng As Range
'Create a new instance of PowerPoint
Set PPTApp = CreateObject("PowerPoint.Application")
PPTApp.Visible = True
PPTApp.Activate
'Create a new Presentation
Set PPTPres = PPTApp.Presentations.Add
'Create a new Slide
Set PPTSlide = PPTPres.Slides.Add(1, ppLayoutBlank)
'Set a reference to the range
Set ExcRng = Range("B1:J31")
'Copy Range
ExcRng.Copy
'Paste the range in the slide
Set PPTShape = PPTSlide.Shapes.PasteSpecial(10)
'Select the shape.
PPTSlide.Shapes(PPTSlide.Shapes.Count).Select
'Set the Dimensions of the shape.
With PPTApp.ActiveWindow.Selection.ShapeRange
.Top = 65
.Left = 7.2
.Width = 700
End With
'Erase Objects from memory.
Set PPTApp = Nothing
Set PPTSlide = Nothing
Set PPTShape = Nothing
End Sub
