Access/VBA Library

AutoCreateSection

Creates a section before the currently selected slides. When more than one slides have been selected also a section after the selected slides will be created.

Syntax

AutoCreateSection()
Return value

Boolean : Indicates whether at least one section has been created.

Code
Public Function AutoCreateSection() As Boolean
    Dim LastSlideIndex As Long
    Dim Index As Long
    Dim SectionIndex As Long
    Dim CurrentSlide As Slide
    Dim Hidden As Boolean
    '
    ' Check if any slide is active
    '
    If ActiveSlide Is Nothing Then Exit Function
    '
    ' Get the current section
    '
    With ActivePresentation.SectionProperties
        SectionIndex = .AddBeforeSlide(ActiveSlide.SlideIndex, DefaultSectionName(ActiveSlide))
    End With
    '
    ' When just one slide is selected, then we are done. Otherwise a second section
    ' should be added
    '
    AutoCreateSection = True
    If ActiveWindow.Selection.SlideRange.Count = 1 Then Exit Function
    
    '
    ' Make sure alle events are fired after SectionAdd
    '
    DoEvents
    '
    ' Determine the last slide in selected range
    '
    With ActiveWindow.Selection.SlideRange
        For Index = 1 To .Count
            If .Item(Index).SlideIndex > LastSlideIndex Then
                LastSlideIndex = .Item(Index).SlideIndex
            End If
        Next Index
    End With
    '
    ' Check if there are slides after selected range
    '
    If LastSlideIndex < ActivePresentation.Slides.Count Then
    
        Set CurrentSlide = ActivePresentation.Slides(LastSlideIndex + 1)
        '
        ' If this slide has the same SectionIndex, we have to add a new section
        ' starting with this slide
        '
        If CurrentSlide.SectionIndex = SectionIndex Then
        
            With ActivePresentation.SectionProperties
                Call .AddBeforeSlide(CurrentSlide.SlideIndex, _
                                     DefaultSectionName(CurrentSlide))
            End With
        End If
        
    End If
    '
    ' Make unselected slides within selected range unvisible
    '
    With ActiveWindow.Selection.SlideRange
        While LastSlideIndex >= ActiveSlide.SlideIndex
            
            Set CurrentSlide = ActivePresentation.Slides(LastSlideIndex)
            Hidden = CurrentSlide.SlideShowTransition.Hidden
            CurrentSlide.SlideShowTransition.Hidden = msoTrue
            For Index = 1 To .Count
                
                If .Item(Index).SlideIndex = LastSlideIndex Then
                    CurrentSlide.SlideShowTransition.Hidden = Hidden
                    Exit For
                End If
                
            Next Index
            LastSlideIndex = LastSlideIndex - 1
        Wend
    End With

End Function

PowerPointtag:PowerPoint

See also

  • DefaultSectionName