ma997
09-12-2013, 01:15 PM
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!
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!