代码之家  ›  专栏  ›  技术社区  ›  Ellen Spertus

如何自动隐藏PowerPoint幻灯片?

  •  0
  • Ellen Spertus  · 技术社区  · 8 年前

    我在讲座中使用PowerPoint,并为学生打印幻灯片的子集(以便他们在我展示答案之前填写空白)。目前,我在幻灯片的左下角放了一个浅蓝色的圆圈,我想在打印时(但不是在讲课时)隐藏它。然后,当需要打印幻灯片时,我手动隐藏幻灯片,然后在讲课前取消隐藏所有幻灯片。有什么方法可以使这个过程自动化吗?我在个人电脑和Mac电脑上都使用Office 365。

    1 回复  |  直到 7 年前
        1
  •  1
  •   Ellen Spertus    7 年前

    这将使您开始,将其保存为PPTM,然后将副本保存为加载项:

    ChangeAnswersSlideState -是否将ActiveSlide更改为答案幻灯片
    PrintStudentHandout -隐藏答案幻灯片,然后打印,然后取消隐藏

    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