VBA to copy selected slides into new presentation slide order problem

[Chris Macro]

I have created a macro to copy over only the user selected slides into a brand new PowerPoint presentation. The problem I have noticed is that when slides are selected in consecutive order (ie 4-9), the macro will paste the slides in the correct order. However when the selection is not in consecutive order ( ie 4,5,8,9), it will paste the slides in reverse order. Any thoughts on why this is happening or how I can fix this?

Code:


Sub Copy_Selection_To_New_PPT()

'PURPOSE: Copies selected slides and pastes them into a brand new presentation file


Dim NewPPT As Presentation
Dim Selected_slds As SlideRange
Dim Old_sld As Slide
Dim New_sld As Slide
Dim x As Long


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


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


'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
yy = 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

[John Wilson]

Hi Chris

The order of slides in a SlideRange depends on exactly how they were selected and a little voodoo!

One solution is to sort by Slide Index


Sub chex()
Dim osld As Slide
Dim osldR As SlideRange
Dim L As Long
Dim Ray_INDX() As Long
Set osldR = ActiveWindow.Selection.SlideRange
ReDim Ray_INDX(1 To osldR.Count)
For L = 1 To osldR.Count
Ray_INDX(L) = osldR(L).SlideIndex
Next L
Call SortByPos(Ray_INDX)
Set osldR = ActivePresentation.Slides.Range(Ray_INDX)
End Sub


Sub SortByPos(ArRay_INDX As Variant)
Dim b_Cont As Boolean
Dim lngCount As Long
Dim vSwap As Long
Do
b_Cont = False
For lngCount = LBound(ArRay_INDX) To UBound(ArRay_INDX) - 1
If ArRay_INDX(lngCount) > ArRay_INDX(lngCount + 1) Then
vSwap = ArRay_INDX(lngCount)
ArRay_INDX(lngCount) = ArRay_INDX(lngCount + 1)
ArRay_INDX(lngCount + 1) = vSwap
b_Cont = True
End If
Next lngCount
Loop Until Not b_Cont
End Sub

This is pretty top of head code so you might need to adapt it a little.

[Chris Macro]

Perfect idea John! Thanks so much for the help. By sorting my SlideIndex numbers I can now guarantee a perfect transfer every time :)

Cheers!