CODEWITHSUNDEEP
vbaoffice365powerpoint
Ellen Spertus
Ellen Spertus

Reputation: 6815

How can I automate the hiding of PowerPoint slides?

I use PowerPoint in my lectures and print a subset of the slides for my students (to allow them to fill in blanks before I show my answers). Currently, I put a light blue circle at the bottom left of slides that I want to hide while printing (but not while lecturing). I then manually hide slides when it is time to print them, then unhide all of the slides before lecturing. Is there any way to automate this process? I use Office 365 on both PCs and Macs.

Upvotes: 0

Views: 3032

Answers (2)

Sancarn
Sancarn

Reputation: 2824

The accepted answer is a bit over complicated imo. Ultimately, for a given slide object oSlide:

'To hide a slide
oSlide.SlideShowTransition.Hidden = True

'To show a slide
oSlide.SlideShowTransition.Hidden = false

Upvotes: -1

PatricK
PatricK

Reputation: 6433

This will get you started, save this as pptm then save a copy as addin:

ChangeAnswersSlideState - changes activeslide to be an Answer Slide or not
PrintStudentHandout - Hide Answer slides and then print, then unhide

Option Explicit

Private Const ANS_ID As String = "ANS"

Sub PrintStudentHandout()
    ChangeAnswersSlideVisible
    With ActivePresentation
        .PrintOptions.ActivePrinter = "Microsoft XPS Document Writer"
        .PrintOut
    End With
    ChangeAnswersSlideVisible msoFalse
End Sub

Private Sub ChangeAnswersSlideVisible(Optional Hide As MsoTriState = msoTrue)
    Dim oSlide As Slide, oShp As Shape
    For Each oSlide In ActivePresentation.Slides
        For Each oShp In oSlide.Shapes
            If IsAnswersShape(oShp) Then
                oSlide.SlideShowTransition.Hidden = Hide
                Exit For
            End If
        Next oShp
    Next oSlide
End Sub

Sub ChangeAnswersSlideState()
    Dim oShp As Shape, bChanged As Boolean
    bChanged = False
    For Each oShp In Application.ActiveWindow.View.Slide.Shapes
        If IsAnswersShape(oShp) Then
            oShp.Delete
            bChanged = True
        End If
    Next oShp
    If Not bChanged Then MakeAnswersSlide
End Sub

Private Sub MakeAnswersSlide(Optional ByRef AnswerSlide As Slide = Nothing)
    If AnswerSlide Is Nothing Then Set AnswerSlide = Application.ActiveWindow.View.Slide
    With AnswerSlide.Shapes.AddShape(msoShapeOval, -80, 460, 72, 72)
        .TextFrame.TextRange.Text = ANS_ID
    End With
End Sub

Private Function IsAnswersShape(ByRef CheckShape As Shape) As Boolean
    Dim bIsAnAnswerShape As Boolean
    bIsAnAnswerShape = False
    With CheckShape
        If .AutoShapeType = msoShapeOval Then
            If .HasTextFrame Then
                If .TextFrame.TextRange.Text = ANS_ID Then
                    bIsAnAnswerShape = True
                End If
            End If
        End If
    End With
    IsAnswersShape = bIsAnAnswerShape
End Function

Upvotes: 1

Related Questions