How to prompt user to input slide number(s) then copy slides to new presentation

[ma997]

SCENARIO: Master Slide Presentation is OPEN that contains hundreds of slides. I want to prompt the user to input the slide(s) numbers they want to copy, then use that input range to create a NEW powerpoint presentation.

The code works when a single slide number is typed in (i.e. "10"), however, when I try to type in "10, 15, 16, 20-22" into the input box, the code doesn't work. Here is what I have:


Sub SlideCopytoNewPPT()
' Variable declarations.
Dim SourceView, answer As Integer


Dim SourceSlides, NumPres, x As Long
' Count the open presentations.
NumPres = Presentations.Count
' Check to see whether more than one presentation is open.
If NumPres = 0 Then
' If no presentations are open, stop the macro.
MsgBox "You must have at least one presentation open", _
vbCritical + vbOKOnly, "No Presentations Open"
End
End If
' If more than two presentations are open, quit the macro.
If NumPres > 2 Then
MsgBox "Too many open presentations. Only two presentations" _
& " may be open." & Chr(13) & "The active presentation is " _
& "the source and other presentation is the destination.", _
vbOKOnly + vbCritical, "Too Many Open Presentations"
End
End If
' Stores the current view of the source presentation.
SourceView = ActiveWindow.ViewType
' Count the number of slides in source presentation.
SourceSlides = ActivePresentation.Slides.Count
' See whether only one presentation is open.
If NumPres = 1 Then
answer = MsgBox("Only one presentation is open. " & _
"This presentation will be used as the source. " & _
Chr(13) & "Press YES to create a new presentation as " _
& "the destination.", vbYesNo + vbQuestion, "Only One " _
& "Presentation Open")
' If no selected in the message box, quit the macro.
If answer = vbNo Then
End
End If
' Create a new presentation for the designation.
Presentations.Add
' Set up the slide size to be the same as the source.
With ActivePresentation.PageSetup
.SlideHeight = Presentations(1).PageSetup.SlideHeight
.SlideWidth = Presentations(1).PageSetup.SlideWidth
End With
' Switch the destination presentation to slide view.
If ActiveWindow.ViewType <> ppViewSlide Then
ActiveWindow.ViewType = ppViewSlide
End If
' Switch to the source presentation.
Presentations(1).Windows(1).Activate
End If
' Change the view to slide sorter if not there already.
If ActiveWindow.ViewType <> ppViewSlideSorter Then
ActiveWindow.ViewType = ppViewSlideSorter
End If
' Loop through all the slides and copy them to destination one by
' one.
For x = InputBox("Enter a value") To SourceSlides

' Select the first slide in the presentation and copy it.
ActivePresentation.Slides.Range(Array(x)).Select
ActiveWindow.Selection.Copy
' Switch to destination presentation.
Presentations(2).Windows(1).Activate
' Create a new slide.
ActivePresentation.Slides.Add _
ActivePresentation.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:=ActivePresentation.Slides.Count
' Paste the slide.
ActiveWindow.ViewType = ppViewSlideSorter
ActiveWindow.View.Paste



' Adjust the size of the pasted object.
With ActiveWindow.Selection.ShapeRange
.Left = 0
.Top = 0
.Width = ActivePresentation.PageSetup.SlideWidth
.Height = ActivePresentation.PageSetup.SlideHeight
End With

' Unselect the object.
ActiveWindow.Selection.Unselect
' Switch to source.
Presentations(1).Windows(1).Activate
Next x
' Restore the current view to source.
ActiveWindow.ViewType = SourceView
End Sub


My ultimate goal is to use an excel spreadsheet as the source of the range and generate the new powerpoint presentation from Excel, but this needs to work first. Thanks in advance!

[John Wilson]

This is the problem
For x = InputBox("Enter a value") To SourceSlides

' Select the first slide in the presentation and copy it.
ActivePresentation.Slides.Range(Array(x)).Select

x is NOT an array it is always going to be a string.

If you enter the slides like 1,4,6,8,etc it is fairly easy to get an array by using the SPLIT method BUT if you use 2,4,6,12-20 etc it is going to be really difficult (possible though).

Maybe you could just select the chosen slides in slide sorter view?

[ma997]

I'm literally reading Excel VBA Programming for Dummies as we speak....I tried using STRING instead of Range, and it didn't help. I am really a novice and am trying to tweak this one input to generate a group of slides to copy to a new presentation. Any help is greatly appreciated.

[John Wilson]

You are not understanding the problem you need to parse the string (e.g. "1,2,3,4-8") into an array and this is not simplke if you are not a coder.

This is just off the top of my head but might get you on the right track.

Sub getSelection()
Dim L As Long
Dim rayFixed() As Variant
Dim sldR As SlideRange
Dim strInput As String
Dim raySlides() As Long
strInput = InputBox("Input slides to select")
rayFixed = getArray(strInput)
ReDim raySlides(0 To UBound(rayFixed))
For L = 0 To UBound(rayFixed)
raySlides(L) = CLng(rayFixed(L))
Next L
ActiveWindow.ViewType = ppViewSlideSorter
Set sldR = ActivePresentation.Slides.Range(raySlides)
sldR.Select ' or copy etc
End Sub

Function getArray(strIn As String) As Variant
Dim rayNum() As String
Dim rayTemp() As String
Dim L As Long
Dim X As Long
Dim rayCorrect() As Variant
rayNum = Split(strIn, ",")
ReDim rayCorrect(0 To 0)
For L = 0 To UBound(rayNum)
'deal with x-y type
If InStr(1, rayNum(L), "-") > 0 Then
rayTemp = Split(rayNum(L), "-")
For X = rayTemp(0) To rayTemp(1)
rayCorrect(UBound(rayCorrect)) = CStr(X)
ReDim Preserve rayCorrect(0 To UBound(rayCorrect) + 1)
Next X
Else
'deal with x,y type
rayCorrect(UBound(rayCorrect)) = rayNum(L)
ReDim Preserve rayCorrect(0 To UBound(rayCorrect) + 1)
End If
Next
'remove top blank value
ReDim Preserve rayCorrect(0 To UBound(rayCorrect) - 1)
getArray = rayCorrect
End Function

[SoftMast]

ty