如何在powerpoint上加个1分钟提示，现在是5分钟后关闭幻灯片？

这是我从网上搜的，5分钟到时自动关闭PPT播放的代码，到时前一分钟提示的没有写，哪位高手帮写个到时前一分钟提示的代码啊。
Option Explicit
Public Declare Function SetTimer Lib "user32.dll" (ByVal hwnd As Long, ByVal nIDEvent As Long, ByVal uElapse As Long, ByVal lpTimerFunc As Long) As Long
Public Declare Function KillTimer Lib "user32.dll" (ByVal hwnd As Long, ByVal nIDEvent As Long) As Long
Private Declare PtrSafe Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Public hwnd As Long
Const CLNPPT = "PPTFrameClass"
Dim pptCode As New Class1
Public Sub BeginTimer()
hwnd = FindWindow(CLNPPT, vbNullString)
‘300000 is the time for 5 minutes. The unit is Milliseconds.
    SetTimer hwnd, 1, 300000, AddressOf TimerProc
End Sub
Public Sub TimerProc(ByVal hwnd As Long, _
    ByVal uMsg As Long, _
    ByVal idEvent As Long, _
    ByVal dwTime As Long)

    Dim l As Long

    l = KillTimer(hwnd, 1)

    If l = 0 Then MsgBox "failed!"

    SlideShowWindows(Index:=1).View.Exit
    'ActiveWindow.Close
    MsgBox "时间到!"
End Sub
Sub Main()
  Set pptCode.ppShow = Application
End Sub
• 插入一个类模块，在类模块1中复制黏贴如下代码：
Public WithEvents ppShow As Application
Private Sub ppShow_SlideShowBegin(ByVal Wn As SlideShowWindow)
    BeginTimer
End Sub
注意：每次打开文档时或者修改代码后，都必须启动Main宏。当幻灯片开始播放，则开始计时。

5 个解决方案

#1

再加个timer就行。
Option Explicit
Public Declare Function SetTimer Lib "user32.dll" (ByVal hwnd As Long, ByVal nIDEvent As Long, ByVal uElapse As Long, ByVal lpTimerFunc As Long) As Long
Public Declare Function KillTimer Lib "user32.dll" (ByVal hwnd As Long, ByVal nIDEvent As Long) As Long
Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Public hwnd As Long
Const CLNPPT = "PPTFrameClass"
Dim pptCode As New Class1
Public Sub BeginTimer()
hwnd = FindWindow(CLNPPT, vbNullString)
'300000 is the time for 5 minutes. The unit is Milliseconds.
    SetTimer hwnd, 1, 10000, AddressOf TimerProc
    SetTimer hwnd, 2, 5000, AddressOf showone
End Sub
Public Sub TimerProc(ByVal hwnd As Long, _
    ByVal uMsg As Long, _
    ByVal idEvent As Long, _
    ByVal dwTime As Long)

    Dim l As Long

    l = KillTimer(hwnd, 1)

    If l = 0 Then MsgBox "failed!"

    SlideShowWindows(Index:=1).View.Exit
    'ActiveWindow.Close
    MsgBox "Ê±¼äµ½!"
End Sub
Public Sub showone(ByVal hwnd As Long, _
    ByVal uMsg As Long, _
    ByVal idEvent As Long, _
    ByVal dwTime As Long)

    Dim l As Long

    l = KillTimer(hwnd, 2)


    MsgBox "»¹Ê£1·ÖÖÓ"
End Sub

Sub Main()
  Set pptCode.ppShow = Application
End Sub

#2

第二个timer是4*60*1000。

#3

我试着运行了一下，结果不一会就提示还有1分钟，运行了一会后幻灯片就退出了，没有运行5分钟就结束了，请问是什么原因？谢谢！！！

#4

SetTimer hwnd, 1, 10000, AddressOf TimerProc
SetTimer hwnd, 2, 5000, AddressOf showone

把上面的10000改成300000
5000改成240000。

#5

mark

#1

#2