用VBA在PPT中制作假屏幕保护程序

Sub FakeScreenSaver()
    Dim Slide As Slide
    Dim SlideShowWindow As SlideShowWindow
    
    ' 隐藏PPT窗口
    Application.Visible = False
    
    ' 创建一个新的幻灯片放映窗口
    Set SlideShowWindow = SlideShowWindows.Add(1)
    
    ' 设置幻灯片放映窗口为全屏模式
    SlideShowWindow.View.Type = ppViewSlideShow
    SlideShowWindow.View.State = ppSlideShowRunning
    
    ' 循环播放幻灯片，直到按下ESC键退出
    Do Until SlideShowWindow.View.State = ppSlideShowStopped
        For Each Slide In ActivePresentation.Slides
            SlideShowWindow.View.GotoSlide Slide.SlideIndex
            DoEvents
        Next Slide
    Loop
    
    ' 关闭幻灯片放映窗口
    SlideShowWindow.View.Exit
    SlideShowWindow.Close
    
    ' 显示PPT窗口
    Application.Visible = True
End Sub