Generic function to obtain active slide in any view

Show below is a generic function which returns the active slide object in any given view. This routines is really useful to determine various slide properties of the active slide. Two examples on how to use the function are provided too. The function requires the window object of the active view as an argument. Depending upon the window object it determines the view type and returns the slide object reference.

' --------------------------------------------------------------------------------
' Copyright ©1999-2007, Shyam Pillai, All Rights Reserved.
' --------------------------------------------------------------------------------
' You are free to use this code within your own applications, add-ins,
' documents etc but you are expressly forbidden from selling or
' otherwise distributing this source code without prior consent.
' This includes both posting free demo projects made from this
' code as well as reproducing the code in text or html format.
' --------------------------------------------------------------------------------

Function GetActiveSlide(ByVal oWnd As Object) As Object
    Dim SlideNum As Integer
    Dim oPres As Object    'Presentation
    
    On Error GoTo ErrGetActiveSlide
    Set oPres = oWnd.Presentation
    SlideNum = 0
    If oPres.Slides.Count > 0 Then
        Select Case TypeName(oWnd)
        Case "DocumentWindow"
            Select Case oWnd.View.Type
            Case ppViewSlideMaster
                SlideNum = -1
            Case ppViewTitleMaster
                SlideNum = -2
            Case ppViewSlideMaster
                SlideNum = -1
            Case ppViewTitleMaster
                SlideNum = -2
            Case ppViewNotesMaster
                SlideNum = -3
            Case ppViewHandoutMaster
                SlideNum = -4
            Case ppViewSlide, ppViewNotesPage
                SlideNum = oWnd.View.Slide.SlideIndex
            Case ppViewSlideSorter
                If oWnd.Selection.Type = ppSelectionSlides Then
                    If oWnd.Selection.SlideRange.Count = 1 Then
                        SlideNum = oWnd.Selection.SlideRange.SlideIndex
                    End If
                End If
            Case ppViewOutline
                If oWnd.Selection.SlideRange.Count = 1 Then
                    SlideNum = oWnd.Selection.SlideRange.SlideIndex
                End If
            Case ppViewNormal
                Select Case GetViewType(oWnd)
                Case ppViewSlideMaster
                    SlideNum = -1
                Case ppViewHandoutMaster
                    SlideNum = -2
                Case ppViewNotesMaster
                    SlideNum = -3
                Case ppViewTitleMaster
                    SlideNum = -4
                Case 11                   'ppViewThumbnails
                    SlideNum = -5
                Case Else
                    SlideNum = oWnd.View.Slide.SlideIndex
                End Select
            End Select

        Case "SlideShowWindow"
            SlideNum = oWnd.View.Slide.SlideIndex
        End Select
    End If
    Select Case SlideNum
    Case Is > 0
        Set GetActiveSlide = oPres.Slides(SlideNum)
    Case Is = -1
        Set GetActiveSlide = oPres.SlideMaster
    Case Is = -2
        Set GetActiveSlide = oPres.TitleMaster
    Case Is = -3
        Set GetActiveSlide = oPres.NotesMaster
    Case Is = -4
        Set GetActiveSlide = oPres.HandoutMaster
    Case Is = -5
        Set GetActiveSlide = oWnd.Selection.SlideRange(1)
    Case Is = 0
        Set GetActiveSlide = Nothing
    End Select
    Exit Function
ErrGetActiveSlide:
    Set GetActiveSlide = Nothing
End Function

Function GetViewType(oWnd As Object) As Integer
    With oWnd
        If .ViewType = ppViewNormal Then
            GetViewType = .ActivePane.ViewType
        Else
            GetViewType = .ViewType
        End If
    End With
End Function

Sub TestNormalWindow()
Dim TheSelectedSlide As Object
Set TheSelectedSlide = GetActiveSlide(ActiveWindow)
If TheSelectedSlide Is Nothing Then
    MsgBox "Nothing appropriate is selected.", vbExclamation
Else
    MsgBox "You selected a " & TypeName(TheSelectedSlide), vbExclamation
End If
End Sub

Sub TestShowWindow()
Dim TheSelectedSlide As Object
If SlideShowWindows.Count > 0 Then
    Set TheSelectedSlide = GetActiveSlide(SlideShowWindows(1))
    Debug.Print TheSelectedSlide .SlideIndex
End If
End Sub

This snippet restores the imported image shape to it's original dimensions and restores the defaults of other related properties like Contrast and Brightness. The routines assumes that the current selection is a picture on the slide.

Top

' --------------------------------------------------------------------------------
' Copyright ©1999-2007, Shyam Pillai, All Rights Reserved.
' --------------------------------------------------------------------------------
' You are free to use this code within your own applications, add-ins,
' documents etc but you are expressly forbidden from selling or
' otherwise distributing this source code without prior consent.
' This includes both posting free demo projects made from this
' code as well as reproducing the code in text or html format.
' --------------------------------------------------------------------------------

Sub ResetPictureProperties()

With ActiveWindow.Selection.ShapeRange
        .LockAspectRatio = msoFalse
        .ScaleWidth 1, True, msoScaleFromTopLeft
        .ScaleHeight 1, True, msoScaleFromTopLeft
        .LockAspectRatio = True
        .PictureFormat.ColorType = msoPictureAutomatic
        .PictureFormat.Brightness = 0.5
        .PictureFormat.Contrast = 0.5
End With

End Sub

Top