How do you copy a slide from a powerpoint presentation to a new presentation

I have multiple powerpoint templates (2007). I am trying to copy the slides from each of these templates into a new presentation. I am trying to get the syntax to copy the entire slide from one presentation to a new presentation.

Thanks for any suggestions or ideas on how to get this done.
Thanks...
Sub SlideCopy()
 
      ' Variable declarations.
      Dim SourceView, answer As Integer
      Dim SourceSlides, NumPres, x As Long
 
      ' Stores the current view of the source presentation.
      SourceView = ActiveWindow.ViewType
 
      ' Count the number of slides in source presentation.
      SourceSlides = objPresentation.Slides.Count 'objPresentatio.Slides.Count '
 
         ' Create a new presentation for the designation.
         Presentations.Add
 
        Set objPresentation2 = ActivePresentation
         
         With objPresentation2.PageSetup
            .SlideHeight = objPresentation.PageSetup.SlideHeight
            .SlideWidth = objPresentation.PageSetup.SlideWidth
        End With
 
         ' Switch to the source presentation.
         objPresentation.Windows(1).Activate
 
      ' Loop through all the slides and copy them to destination one by one.
      For x = 1 To SourceSlides
         ' Select the first slide in the presentation and copy it.
 
         objPresentation.Slides(1).Copy
         'ActiveWindow.Selection.Copy
 
         ' Switch to destination presentation.
         objPresentation2.Windows(1).Activate
 
         ' Create a new slide.
         objPresentation2.Slides.Add _
            objPresentation2.Slides.Count + 1, ppLayoutBlank
 
         ' Make sure the new presentation is slide view.
         If ActiveWindow.ViewType <> ppViewSlide Then
            ActiveWindow.ViewType = ppViewSlide
         End If
 
         ' Switch to the proper slide.
         ActiveWindow.View.GotoSlide Index:=objPresentation2.Slides.Count
 
         ' Paste the slide.
         objPresentation2.Slides.Paste    'ActiveWindow.View.Paste
 
         ' Unselect the object.
         ActiveWindow.Selection.Unselect
 
         ' Switch to source.
         objPresentation.Windows(1).Activate
 
      Next x
 
      ' Restore the current view to source.
      ActiveWindow.ViewType = SourceView
 
   End Sub

Open in new window

DekkaGAsked:
Who is Participating?
I wear a lot of hats...

"The solutions and answers provided on Experts Exchange have been extremely helpful to me over the last few years. I wear a lot of hats - Developer, Database Administrator, Help Desk, etc., so I know a lot of things but not a lot about one thing. Experts Exchange gives me answers from people who do know a lot about one thing, in a easy to use platform." -Todd S.

ioanePlanning & Analytics ManagerCommented:
Try this, it may give you some ideas:
Sub SlideCopy()
    Dim oldP As Presentation
    Dim newP As Presentation
    Dim s As Slide
    Dim vt As Long
    
    Set oldP = Presentations(1)
    Set newP = Presentations(2)
    
    vt = newP.Windows(1).ViewType
    newP.Windows(1).ViewType = ppViewOutline
    For Each s In oldP.Slides
        s.Copy
        newP.Slides.Paste
    Next s
    newP.Windows(1).ViewType = vt
End Sub

Open in new window

0
DekkaGAuthor Commented:
Tramtrak,
This works great, but it isn't bringing over the formatting or slide design/background.
I adjusted your code (as below).

Any ideas?

Thanks

Sub SlideCopy2()
    Dim oldP As Presentation
    Dim newP As Presentation
    Dim s As Slide
    Dim vt As Long
    
    Set oldP = objPresentation 'Presentations(1)
    
    Presentations.Add
    Set objPresentation2 = ActivePresentation
    Set newP = objPresentation2 'Presentations(2)
    
    vt = newP.Windows(1).ViewType
    newP.Windows(1).ViewType = ppViewOutline
    For Each s In oldP.Slides
        s.Copy
        newP.Slides.Paste
    Next s
    newP.Windows(1).ViewType = vt
End Sub

Open in new window

0
ioanePlanning & Analytics ManagerCommented:
Hi DekkaG,

How about this:
Sub SlideCopy()
    Dim oldP As Presentation
    Dim newP As Presentation
    Dim s As Slide
    Dim cl As CustomLayout
    Dim vt As Long
    
    Set oldP = Presentations("Presentation1")
    Set newP = Presentations("Presentation2")
    
    vt = newP.Windows(1).ViewType
    newP.Windows(1).ViewType = ppViewOutline
    For Each s In oldP.Slides
        s.Copy
        Set cl = s.CustomLayout
        newP.Slides.Paste
        newP.Slides(newP.Slides.Count).CustomLayout = cl
    Next s
    newP.Windows(1).ViewType = vt
End Sub

Open in new window

0

Experts Exchange Solution brought to you by

Your issues matter to us.

Facing a tech roadblock? Get the help and guidance you need from experienced professionals who care. Ask your question anytime, anywhere, with no hassle.

Start your 7-day free trial
DekkaGAuthor Commented:
Hi Tramtrak,
Sorry for getting back to you so late. I was out of town for the past few days.

I was able to implement this solution with just a few problems:
The new template doesn't look like it is starting with a blank template and has one of the content boxes (with the icons for inserting tables, charts, smart art, etc.) on the right half of the template.

Also it looks like the object (text boxes and background) are misaligned compared to the original template. If you want I can open this up in another question.

Hopefully, these are easy issues to resolve. It is looking great so far though...
I couldn't have gotten this far without your help.

Dekka...
0
ioanePlanning & Analytics ManagerCommented:
Hi Dekka,

I'm not sure what the problem is with the extra content box, are you sure this is not on the original slide? Maybe hidden?

You may also want to check all the layout properties for the original presentation match the new presentation.

A new question might be best.

Cheers.
0
It's more than this solution.Get answers and train to solve all your tech problems - anytime, anywhere.Try it for free Edge Out The Competitionfor your dream job with proven skills and certifications.Get started today Stand Outas the employee with proven skills.Start learning today for free Move Your Career Forwardwith certification training in the latest technologies.Start your trial today
Microsoft PowerPoint

From novice to tech pro — start learning today.