Copy and paste range to PPT VBA

[jparry6]

I need to be able to copy a certain range from a sheet in excel to a certain slide in PowerPoint. I have some code taken from the internet and after lots of fiddling around I can't get it to what I need.

The code I've got opens up a new PPT doc, but I need the copied data to be pasted into a certain slide in the active PPT document. Could someone advise on what needs changing?

The code is below:

Sub ExcelRangeToPowerPoint()
'PURPOSE: Copy/Paste An Excel Range Into a New PowerPoint Presentation
'SOURCE: www.TheSpreadsheetGuru.com


Dim rng As Range
Dim PowerPointApp As Object
Dim myPresentation As Object
Dim mySlide As Object
Dim myShape As Object


'Copy Range from Excel
Set rng = ThisWorkbook.ActiveSheet.Range("A5:F51")


'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


'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 DataType:=2 '2 = ppPasteEnhancedMetafile
Set myShape = mySlide.Shapes(mySlide.Shapes.Count)

'Set position:
myShape.Left = 41.76
myShape.Top = 70.56
myShape.Height = 339.12
myShape.Width = 245.52



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


'Clear The Clipboard
Application.CutCopyMode = False

End Sub


*********

I think it's this section that needs adapting but I can't figure out how:

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

'Add a slide to the Presentation
Set mySlide = myPresentation.Slides.Add(1, 11) '11 = ppLayoutTitleOnly



Thanks in advance
JP

 

[areed1192]

So are you getting a particular error when you're running the code or is it not exporting the Excel range you specified? I can pass along some code that will export a single excel range to PowerPoint using VBA for you and hopefully that will work.

Sub ExportRangeToPowerPoint()


    Dim PPTApp As PowerPoint.Application
    Dim PPTPres As PowerPoint.Presentation
    Dim PPTSlide As PowerPoint.Slide
    
    Dim ExcRng As Range
    
    'Create a new instance of PowerPoint
    Set PPTApp = New PowerPoint.Application
        PPTApp.Visible = True
    
    '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 = [COLOR=#574123]ActiveSheet.Range("A5:F51")[/COLOR]
    
    'Copy Range
    ExcRng.Copy
    
    'Paste the range in the slide
    PPTSlide.Shapes.Paste
    
    'Create another slide
    Set PPTSlide = PPTPres.Slides.Add(2,[COLOR=#574123] ppLayoutTitleOnly[/COLOR])
    
    PPTSlide.Shapes.PasteSpecial DataType:=[COLOR=#574123]ppPasteEnhancedMetafile[/COLOR]


End Sub

Now keep in mind that this code is using early binding versus late binding like your code, but other than that I tried to make the code do what you were doing in yours. Also be careful with the "ThisWorkbook", that's referring to the workbook that houses the code but say you have this code in your personal macro workbook then it won't work because it will refer to your Personal Macro Workbook.

If you want to see how this code runs you can follow the link to my YouTube video where I walk through the code.
https://youtu.be/t6M9E5eMmXU

FULL DISCLOSURE THIS IS MY PERSONAL YOUTUBE CHANNEL.