Paste Excel Range into Powerpoint

[o0omax]

Hello,

I found an interesting code at: https://www.thespreadsheetguru.com/blog/2014/3/17/copy-paste-an-excel-range-into-powerpoint-with-vba

Now I want to adapt the code, that it doesn´t always open a new ppt, but pastes it in the presentation which is open (into a new tab). I tries to modify the code but it didn´t work. Can somebody help`?

Office 2016, I already activated the PPT Library in VBA.

Here ist the code


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("A1:C12")

'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 = 66
myShape.Top = 152

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

'Clear The Clipboard
Application.CutCopyMode = False

End Sub

[snb]

A linked range:

Sheet1.Range("C6:F17") in the file that contains the macro


Sub M_snb()
c00 = ActiveWorkbook.Path & "\"
c01 = Replace(Mid(Sheet1.Range("C6:F17").Address(, , 2, 2), 2), "]", "!")

With CreateObject("powerpoint.application")
.Visible = True
.presentations.Add().slides.Add(1, 12).Shapes.AddOLEObject 20, 20, , , , c00 & c01, , , , , True
End With
End Sub

NB. The simpler the code the simpler to adapt.

To add in a presentation that is already open:


Sub M_snb_001()
c00 = ActiveWorkbook.Path & "\"
c01 = Replace(Mid(Sheet1.Range("C6:F17").Address(, , 2, 2), 2), "]", "!")

With GetObject(, "powerpoint.application")
.Visible = True
.presentations(1).slides.Add(1, 12).Shapes.AddOLEObject 20, 20, , , , c00 & c01, , , , , True
End With
End Sub

[o0omax]

When I run your code it says object not found.

I tried to modify the code, becuase the one posted upside is working.

PS: I´m new to VBA