Article ID: 163857
Article Last Modified on 10/11/2006
Sub InsertMultipleSlides()
' Used for error trapping.
On Error Resume Next
Err.Clear
' Change this value to the maximum number of slides you want to
' create.
Const MAX_SLIDES As Long = 250
' Change this to the auto layout you want to use. This value can be
' any PpSlideLayout constant.
Const DEFAULT_AUTO_LAYOUT As Long = ppLayoutText
' Dimension the variables.
Dim lLastSlide, i As Long
Dim lToCreate, lResult As Long
Dim Continue As Boolean
Dim strInputPrompt, strResult, strPlural As String
' Initialize the message for the input box.
strInputPrompt = "Enter the number of slides you want to create. "
' Loop until valid input.
Do
' Ask how many slides do you want to create.
strResult = InputBox(strInputPrompt)
' Check for valid input.
If strResult = "" Then
' If NULL string returned, stop the macro.
End
End If
' Convert string to integer.
lToCreate = CLng(strResult)
' Check for a type mismatch.
If Err.Number <> 0 Then
' Reset the err object.
Err.Clear
' Repeat the loop.
Continue = False
End If
' Check for valid entry.
If lToCreate <= MAX_SLIDES And lToCreate > 0 Then
Continue = True
Else
Continue = False
End If
' Change the message of input box if invalid entry is made.
If Continue = False Then
strInputPrompt = "Invalid entry, please enter a value " _
& "between 1 and " & MAX_SLIDES & "." & Chr(13) _
& Chr(13) & strInputPrompt
End If
Loop Until Continue = True
' See whether slides or slide is needed in the MsgBox.
If lToCreate = 1 Then
strPlural = "slide"
Else
strPlural = "slides"
End If
' Ask for confirmation.
lResult = MsgBox("Are you sure you want to create " & lToCreate _
& " new " & strPlural & ", at the end of the presentation, using " _
& "the Bulleted List auto layout?", vbYesNo + vbQuestion)
' Find out what the user selected in the message box.
If lResult = vbNo Then
'Stop the Macro.
End
End If
' Get the number of slides in the active presentation.
lLastSlide = ActivePresentation.Slides.Count
' Create the new slides.
For i = 1 To lToCreate
lLastSlide = lLastSlide + 1
ActivePresentation.Slides.Add lLastSlide, DEFAULT_AUTO_LAYOUT
' Find out whether error occurred when creating the new slides.
If Err.Number <> 0 Then
MsgBox "Unable to add new slides to the presentation. " _
, vbCritical, "Error When Adding New Slides"
' Stop the macro.
End
End If
Next i
' Display closing message.
MsgBox "Successfully added " & lToCreate & " " & strPlural & _
" to the active presentation.", vbInformation, "Macro Done"
End Sub
176476 OFF: Office Assistant Not Answering Visual Basic Questions
163435 VBA: Programming Resources for Visual Basic for Applications
Additional query words: 8.00 ppt8 vba vbe ppt97 macppt98 ppt98 mac
Keywords: kbcode kbdtacode kbhowto kbmacro kbprogramming KB163857