none
powerpiont2003如何设置ppt播放在预设时间到了自动停止或退出程序 RRS feed

  • 问题

  • powerpiont2003如何设置ppt播放在预设几分钟时间到了就自动停止或退出程序,谢谢,最好之前一分钟还有个提示!
    • 已移动 ThankfulHeart 2012年6月1日 12:55 Office编程问题 (发件人:Visual Basic)
    2012年6月1日 12:49

全部回复

  • Hi,

    我觉得你要实现这个功能,必须使用vba代码来实现。

    你可以用一个计时器来记录已经经过的时间。当记录的时间离预先设定的时间还有一分钟时,弹出提示。当记录的时间等于与现实定的时间时,就自动跳出播放。


    Jaynet Zhang

    TechNet Community Support

    2012年6月4日 5:39
    版主
  • Hi,

    我觉得你要实现这个功能,必须使用vba代码来实现。

    你可以用一个计时器来记录已经经过的时间。当记录的时间离预先设定的时间还有一分钟时,弹出提示。当记录的时间等于与现实定的时间时,就自动跳出播放。


    Jaynet Zhang

    TechNet Community Support

    您好,能否帮写一个VBA的实现,谢谢,那个东西真不熟悉!



    2012年6月4日 7:12
  • Hi

    我只帮你写了5分钟到时自动关闭PPT播放的代码,到时前一分钟提示的没有写。

    • Alt + F11, 插入一个模块, 在“模块1”中复制黏贴如下代码:

    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 "time up!"

    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宏。当幻灯片开始播放,则开始计时。


    Jaynet Zhang

    TechNet Community Support

    2012年6月5日 4:29
    版主
  • 首先,谢谢大侠!另外我安装您的提示一步一步的操作了,而且我把时间  SetTimer hwnd, 1, 300000, AddressOf TimerProc改成了 SetTimer hwnd, 1, 120000, AddressOf TimerProc希望尽快实现效果,启用了main宏,但是最后没有效果,问题出在哪了?麻烦帮我找下,谢谢!还有能否实现那个提前一分钟提示,谢谢!

    还有我调试程序的时候提示 PtrSafe这里出现这个对话框:

    ---------------------------
    Microsoft Visual Basic
    ---------------------------
    编译错误:

    缺少: Sub 或 Function
    ---------------------------
    确定   帮助  
    ---------------------------

    2012年6月5日 5:02
  • Hi,

    删除“模块1”中的代码,复制以下的代码。之前的那个代码是针对2010版本的。以下的代码是所有版本都兼容的。

    Option Explicit

    ' *********************
    ' For PowerPoint 2010.
    ' *********************
    #If VBA7 Then
        ' The window handle of Outlook.
        Dim lHwnd As LongPtr
       
        ' /* API declarations. */
        Private Declare PtrSafe Function SetTimer Lib "user32" (ByVal hwnd As LongPtr, _
            ByVal nIDEvent As Long, _
            ByVal uElapse As Long, _
            ByVal lpTimerFunc As LongPtr) As Long
        Private Declare PtrSafe Function KillTimer Lib "user32" (ByVal hwnd As LongPtr, ByVal nIDEvent As Long) As Long
            Public Declare PtrSafe Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, _
            ByVal lpWindowName As String) As LongPtr
       
    ' *********************************************
    ' For the previous version of PowerPoint 2010.
    ' *********************************************
    #Else
        ' The window handle of Outlook.
        Dim lHwnd As Long
       
        ' /* API declarations. */
        Private Declare Function KillTimer Lib "user32" (ByVal hwnd As Long, ByVal nIDEvent As Long) As Long
        Private Declare Function SetTimer Lib "user32" (ByVal hwnd As Long, _
            ByVal nIDEvent As Long, _
            ByVal uElapse As Long, _
            ByVal lpTimerFunc As Long) As Long
        Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, _
            ByVal lpWindowName As String) As Long
    #End If

    Const CLNPPT = "PPTFrameClass"

    Dim pptCode As New Class1

    Public Sub BeginTimer()
        lHwnd = FindWindow(CLNPPT, vbNullString)
        SetTimer lHwnd, 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(lHwnd, 1)
       
        If l = 0 Then MsgBox "failed!"
       
        SlideShowWindows(Index:=1).View.Exit
        'ActiveWindow.Close
        MsgBox "time up!"
    End Sub

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


    Jaynet Zhang

    TechNet Community Support

    2012年6月5日 8:33
    版主
  • 谢谢您!还是报如下错误:

    ---------------------------
    Microsoft Visual Basic
    ---------------------------
    编译错误:

    用户定义类型未定义
    ---------------------------
    确定   帮助  
    ---------------------------

    下面的代码显示红色!

     Private Declare PtrSafe Function SetTimer Lib "user32" (ByVal hwnd As LongPtr, _
            ByVal nIDEvent As Long, _
            ByVal uElapse As Long, _
            ByVal lpTimerFunc As LongPtr) As Long
        Private Declare PtrSafe Function KillTimer Lib "user32" (ByVal hwnd As LongPtr, ByVal nIDEvent As Long) As Long
            Public Declare PtrSafe Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, _
            ByVal lpWindowName As String) As LongPtr

    2012年6月5日 12:17
  • Hi,

    把这三段函数换成如下代码试一下:

        Private Declare Function KillTimer Lib "user32" (ByVal hwnd As Long, ByVal nIDEvent As Long) As Long
        Private Declare Function SetTimer Lib "user32" (ByVal hwnd As Long, _
            ByVal nIDEvent As Long, _
            ByVal uElapse As Long, _
            ByVal lpTimerFunc As Long) As Long
        Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, _
            ByVal lpWindowName As String) As Long


    Jaynet Zhang

    TechNet Community Support

    2012年6月6日 2:06
    版主
  • 现在还有问题:Dim pptCode As New Class1,报一下错误:

    ---------------------------
    Microsoft Visual Basic
    ---------------------------
    编译错误:

    用户定义类型未定义
    ---------------------------
    确定   帮助  
    ---------------------------

    谢谢!

    另外我进行了调试,发现一个问题:找不到路径安装包Pro11.msi


    2012年6月7日 1:52
  • Hi,

    关于第一个问题,我想问下你的类模块命名是什么,因为我用的是英文版的,插入一个类模块之后,类模块直接被命名为Class1.或者你直接把你的类模块也重命名为Class1,这样就应该不会报错了。

    关于第二个问题,尝试下载一个Pro11.msi文件,如果还是不行的话,试一下修复 或重新安装。

    http://office.microsoft.com/zh-cn/powerpoint-help/automatically-repair-office-programs-HP005237200.aspx


    Jaynet Zhang

    TechNet Community Support

    2012年6月8日 2:27
    版主
  • 我修改成功了,运行提示如下,谢谢!

    ---------------------------

    Microsoft Visual Basic

    ---------------------------

    该工程中的宏被禁止。请参阅联机帮助或主应用程序的文档来决定如何激活宏。

    ---------------------------

    确定   帮助  

    ---------------------------

    2012年6月8日 8:05
  • Hi,

    先查看一下你的宏安全级别设定的是什么。如果您收到宏被禁用的错误消息,则可能是因为宏病毒防护的安全级别设置为了高安全级。要验证当前的安全级别,请按照以下步骤操作:

    1.工具菜单上,指向,然后单击安全性

    2.单击安全级选项卡。(将宏安全级别设置为“低”)

    如果选择了选项,请使用下列方法之一:

    • 向宏添加数字签名。
    • 获取带有数字签名的加载项。
    • 信任所有已安装的加载项。
    • 更改宏病毒防护的级别。

    更多关于此报错的信息以及解决方案,可以参考以下链接:

    http://support.microsoft.com/kb/316731/zh-cn


    Jaynet Zhang

    TechNet Community Support

    2012年6月11日 1:39
    版主
  • 您好,谢谢!我将安全级别设置为最低了,还是报如下错误:

    ---------------------------
    Microsoft Visual Basic
    ---------------------------
    该工程中的宏被禁止。请参阅联机帮助或主应用程序的文档来决定如何激活宏。
    ---------------------------
    确定   帮助  
    ---------------------------

    2012年6月11日 5:12
  • Hi,

    你可以看一下我上一个回复里面的那个链接,里面还有除了设置宏安全级别之外的解决这个报错的方案。你可以试一下。


    Jaynet Zhang

    TechNet Community Support

    2012年6月13日 1:43
    版主