PPT2000: Sample Code to Expand Slides (240189)

MORE INFORMATION

Microsoft provides programming examples for illustration only, without warranty either expressed or implied. This includes, but is not limited to, the implied warranties of merchantability or fitness for a particular purpose. This article assumes that you are familiar with the programming language that is being demonstrated and with the tools that are used to create and to debug procedures. Microsoft support engineers can help explain the functionality of a particular procedure, but they will not modify these examples to provide added functionality or construct procedures to meet your specific requirements.

Sub ExpandSlide()
   ' Enable the error handler.
   '
   On Error GoTo ErrorHandler 
   
   Dim oShape As Shape
   Dim i As Long
   Dim oSlide As Slide
   Dim strTitle As String
   Dim lStrLen As Long
   Dim lParas As Long
   Dim lCurrIndex As Long
   Dim lLastSlide As Long
   Dim ErrMsg As String
   
   ' Check to see if the presentation is in the correct view.
   ' Raise the custom error message 555.
   '
   If ActiveWindow.ViewType <> ppViewNormal And ActiveWindow.ViewType _ 
     <> ppViewSlide Then
      Err.Raise 555, "Expand Slide Macro", _
        "Not in Slide View or Normal View"
   End If
   
   With ActiveWindow.Selection
   ' Set lCurrIndex to the current slide index.
   ' Set lLastslide to the current slide index.
   '
      lCurrIndex = .SlideRange.SlideIndex
      lLastSlide = lCurrIndex
      
   ' Check each shape of the current slide; check to
   ' see if it is a Body placeholder.
   '
      For Each oShape In .SlideRange.Shapes
         If oShape.PlaceholderFormat.Type = ppPlaceholderBody Then
            
   ' Set lParas to the number of paragraphs in the
   ' Body placeholder. Does not differentiate between
   ' first level bullets and lower level bullets.
   '
            lParas = oShape.TextFrame.TextRange.Paragraphs.Count
                     
            For i = 1 To lParas
               
   ' Set strTitle to the current paragraph index.
   '
               strTitle = oShape.TextFrame.TextRange.Paragraphs(i).Text
               
   ' Determine how long the string is. Then, as long as
   ' it is not the last parapgraph in the Body placeholder,
   ' strip off the last two characters, the line feed and
   ' carriage return.
   '
               lStrLen = Len(strTitle)
               If lParas <> i Then
                  strTitle = Left(strTitle, lStrLen - 2)
               End If
               
   ' Set lLastSlide to the next available index position.
   ' Create a news slide, with the Bulleted Text layout.
   ' Assign the text from the current paragraph to the
   ' title placeholder. Return to the original slide.
   '
               lLastSlide = lLastSlide + 1
               Set oSlide = _
                 ActivePresentation.Slides.Add(lLastSlide, ppLayoutText)
               oSlide.Shapes(1).TextFrame.TextRange.Text = strTitle
               ActiveWindow.View.GotoSlide (lCurrIndex)
            Next i
         End If
      Next
   End With
Exit Sub
ErrorHandler:
   ' Create Error message and raise dialog with error message.
   '
   ErrMsg = "Error:" & Err.Source & vbNewLine & Err.Description
   MsgBox ErrMsg, vbCritical, "Error Message"
End Sub