VBA: PowerPoint - Copy slides from one presentation to another

[krehkop]

Hello:

I'm a newbie re: this type of VBA but have done a lot of research (and testing) on the matter before posting here on this site. The code I've come across is too complex for me at the moment. What I would like to do is take slides from an existing presentation and paste those into a new presentation. I want to keep the same format of the presentation the slides are sourced from. Note, the two presentations have the same format/template so I'm assuming this shouldn't be an issue. The old has 10 slides and would be pasted into the new starting with slide #3. The following isn't at all what I'm wanting but wanted to show that I have successfully attempted some things that are useful:

1. Creating a new presentation, getting pictures and data ranges from an existing Excel file and formatting those.

Sub CreateNewPresentation()

Dim ppApp As PowerPoint.Application
Dim ppPres As PowerPoint.Presentation
Dim ppSlide As PowerPoint.Slide
Set ppApp = New PowerPoint.Application
ppApp.Visible = True
ppApp.Activate
Set ppPres = ppApp.Presentations.Add

Dim ExcShape As Excel.Shape
Dim WrkSht As Worksheet

Workbooks.Open "https://xxxxx365-my.sharepoint.com/...ments/PowerPoint/Xxxxxxxxx_Xxxxxx_Xxxxxx.xlsx"

'////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

'Slide 1
Set ppSlide = ppPres.Slides.Add(1, ppLayoutTitle)
ppSlide.Shapes(1).TextFrame.TextRange = "Sample Client Presentation"
ppSlide.Shapes(2).TextFrame.TextRange = "January - June 2022"

'////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

'SLIDE 2

Set ppSlide = ppPres.Slides.Add(2, ppLayoutBlank)
ppSlide.Select
Sheets(2).Select

For Each ExcShape In ActiveSheet.Shapes
If ExcShape.Type = msoPicture Then
ExcShape.Select
'Copy the Shape
ExcShape.Copy
'Paste Shape in the slide.
ppSlide.Shapes.PasteSpecial DataType:=ppPasteMetafilePicture
Set ppShape = ppSlide.Shapes(ppSlide.Shapes.Count)
ppShape.Select

'Set the dimensions of the shape
With ppApp.ActiveWindow.Selection.ShapeRange
.Left = 10
.Top = 10
.Width = 500
.Left = 10
End With

Exit For
End If
Next

Range("A4", "I14").CurrentRegion.Copy
'ppSlide.Shapes.Paste
ppSlide.Shapes.PasteSpecial DataType:=ppPasteMetafilePicture
Set ppShape = ppSlide.Shapes(ppSlide.Shapes.Count)
ppShape.Select

'Set the dimensions of the shape
With ppApp.ActiveWindow.Selection.ShapeRange
.Left = 10
.Top = 275
.Width = 500
.Left = 10
End With

'////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

ppApp.Activate

End Sub

 

[krehkop]

The 'Working code below' used per the following location solved my issue. Thanks!

Class not registered VBA excel

I'm trying to copy slides from one PowerPoint presentation to another with the use of a VBA script in excel. Found the below code but when trying to run it I receive the following error I'm workin...

stackoverflow.com

Sub Example2()
Dim objPowerPoint As New PowerPoint.Application
Dim objPresentation As Presentation
Dim i As Integer

'open the target presentation
Set objPresentation = objPowerPoint.Presentations.Open("C:\Users\john\Desktop\p123.pptx")
For i = 1 To objPresentation.Slides.Count
objPresentation.Slides.Item(i).Copy
objPowerPoint.Presentations.Item(1).Slides.Paste
objPowerPoint.Presentations.Item(1).Slides.Item(objPowerPoint.Presentations.Item(1).Slides.Count).Design = _
objPresentation.Slides.Item(i).Design
Next i
objPresentation.Close
End Sub