1

This is my first task on PPT Macros. I have the code which can copy the selected slides and pastes into a new presentation, it is very time taking especially when selecting the slides which are not in order e.g(1,2,5,8,9). I am looking for a code where we can give give specific slide numbers in the code, just like above (1,2,5,8,9) and I should be able to change when I have to copy different set of slides. Please look the current below code and suggest accordingly.

'Set variable to Active Presentation
 Set OldPPT = ActivePresentation

'Set variable equal to only selected slides in Active Presentation
 Set Selected_slds = ActiveWindow.Selection.SlideRange

'Sort Selected slides via SlideIndex
'Fill an array with SlideIndex numbers
 ReDim myArray(1 To Selected_slds.Count)
  For y = LBound(myArray) To UBound(myArray)
    myArray(y) = Selected_slds(y).SlideIndex
  Next y

 'Sort SlideIndex array
  Do
  SortTest = False
  For y = LBound(myArray) To UBound(myArray) - 1
    If myArray(y) > myArray(y + 1) Then
      Swap = myArray(y)
      myArray(y) = myArray(y + 1)
      myArray(y + 1) = Swap
      SortTest = True
    End If
  Next y
  Loop Until Not SortTest

 'Set variable equal to only selected slides in Active Presentation (in 
 numerical order)
 Set Selected_slds = OldPPT.Slides.Range(myArray)

'Create a brand new PowerPoint presentation
 Set NewPPT = Presentations.Add

'Align Page Setup
 NewPPT.PageSetup.SlideHeight = OldPPT.PageSetup.SlideHeight
 NewPPT.PageSetup.SlideOrientation = OldPPT.PageSetup.SlideOrientation
 NewPPT.PageSetup.SlideSize = OldPPT.PageSetup.SlideSize
 NewPPT.PageSetup.SlideWidth = OldPPT.PageSetup.SlideWidth

'Loop through slides in SlideRange
 For x = 1 To Selected_slds.Count

'Set variable to a specific slide
Set Old_sld = Selected_slds(x)

'Copy Old Slide
y = Old_sld.SlideIndex
Old_sld.Copy

'Paste Slide in new PowerPoint
NewPPT.Slides.Paste
Set New_sld = Application.ActiveWindow.View.Slide

'Bring over slides design
 New_sld.Design = Old_sld.Design

'Bring over slides custom color formatting
 New_sld.ColorScheme = Old_sld.ColorScheme

'Bring over whether or not slide follows Master Slide Layout (True/False)
 New_sld.FollowMasterBackground = Old_sld.FollowMasterBackground

Next x

End Sub
Pᴇʜ
  • 56,719
  • 10
  • 49
  • 73
Revan Erraboina
  • 155
  • 1
  • 11

1 Answers1

1

This should replace your 'Loop through slides in SlideRange to the end. You should be able to delete all the selected slide code. This just asks the user to input all the slide numbers needed to copy in a comma separated list.

 Sub testr()


 Dim SlideArray As Variant
'Set variable to Active Presentation
 Set OldPPT = ActivePresentation
'Create a brand new PowerPoint presentation
 Set NewPPT = Presentations.Add

    InSlides = InputBox("List the slide numbers separated by commas:", "Slides", 2)

    SlideArray = Split(InSlides, ",")

For x = 0 To UBound(SlideArray)
        sld = CInt(SlideArray(x))

'Set variable to a specific slide
Set Old_sld = OldPPT.Slides(sld)

'Copy Old Slide
y = Old_sld.SlideIndex
Old_sld.Copy

'Paste Slide in new PowerPoint
NewPPT.Slides.Paste
Set New_sld = Application.ActiveWindow.View.Slide

'Bring over slides design
 New_sld.Design = Old_sld.Design

'Bring over slides custom color formatting
 New_sld.ColorScheme = Old_sld.ColorScheme

'Bring over whether or not slide follows Master Slide Layout (True/False)
 New_sld.FollowMasterBackground = Old_sld.FollowMasterBackground

Next x
 End Sub
mooseman
  • 1,997
  • 2
  • 17
  • 29
  • Thank you. I was getting **complie error: sub or function not defined** at the line `Set Old_sld = Selected_slds(sld)` and so I have defined the variable as `Dim Selected_slds As Variant` but now when I run the code it is showing as **Type mismatch** on the same line `Set Old_sld = Selected_slds(sld)`. Please help how to fix this. – Revan Erraboina Jun 25 '19 at 07:12
  • Okay, I made changes to the code for you. The Split was creating text/variant and the slideindex requires integers. – mooseman Jun 25 '19 at 20:16
  • Thank you. This works like charm. Any suggestion on how to learn code like how you did? – Revan Erraboina Jun 26 '19 at 08:18
  • To learn code for VBA in Office, this site is a fantastic reference and follow Steve Rindsberg here for lots of great insight. There are a ton of resources online, just search for "Learn to code in VBA". A lot of the code starts in Excel, but most of it translates to PPT. – mooseman Jul 03 '19 at 13:39