Sauvegarder un diaporama personnalisé

'*************************************
' Procedure launching the message box
'*************************************
Sub SavePresentations()
    Dim myPresentation As Presentation
    Set myPresentation = ActivePresentation
    
    Load UserForm1 ' UserForm initialization
    UserForm1.ComboBox1.Clear ' Cleaning the ComboBox
    For Each nss In myPresentation.SlideShowSettings.NamedSlideShows
        UserForm1.ComboBox1.AddItem nss.Name ' Adding all presentations in the ComboBox
    Next
    UserForm1.Show ' Showing UserForm
End Sub

'******************************************
' Procedure saving the presentation chosen
'******************************************
Sub ValidateChoice()
    Dim prsthis As Presentation
    Dim prsThat As Presentation
    Dim sldThis As Slide
    Dim sldThat As SlideRange
    Dim nss As NamedSlideShow
    Dim strName As String
    Dim i As Integer
    
    myValue = UserForm1.ComboBox1.Value ' Copying the value of the ComboBox into a variable
    Set prsthis = ActivePresentation
        
    For Each nss In prsthis.SlideShowSettings.NamedSlideShows

        If myValue = nss.Name Then ' nss.Name contains the presentations name
            Set prsThat = Application.Presentations.Add ' Create a new PPT file
            prsThat.ApplyTemplate prsthis.FullName ' Use the same template as the original file
            
            For i = 1 To nss.Count
                Set sldThis = prsthis.Slides.FindBySlideID(nss.SlideIDs(i)) ' Find all slides of the selected presentation
                sldThis.Copy ' Copy the slides
                Set sldThat = prsThat.Slides.Paste ' Paste the slide in the new PPT file
                sldThat.Design = prsthis.Designs(sldThis.Design.Index) ' Index the slides
            Next
            
            strName = prsthis.FullName ' Copy the name of the original PPT file
            prsThat.SaveAs Left(strName, Len(strName) - 4) & "-" & nss.Name ' Save new presentation in a new PPT file with orignal name + presentation name
        End If
    Next
    Unload UserForm1 ' Close UserForm and stop macro
End Sub