powerpiont2003如何设置ppt播放在预设时间到了自动停止或退出程序
问题
全部回复
-
- 已编辑 一定学会CSharp 2012年6月4日 7:13
-
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
-
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 IfConst CLNPPT = "PPTFrameClass"
Dim pptCode As New Class1
Public Sub BeginTimer()
lHwnd = FindWindow(CLNPPT, vbNullString)
SetTimer lHwnd, 1, 300000, AddressOf TimerProc
End SubPublic 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 SubSub Main()
Set pptCode.ppShow = Application
End SubJaynet Zhang
TechNet Community Support
-
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 LongJaynet Zhang
TechNet Community Support
-
Hi,
关于第一个问题，我想问下你的类模块命名是什么，因为我用的是英文版的，插入一个类模块之后，类模块直接被命名为Class1.或者你直接把你的类模块也重命名为Class1，这样就应该不会报错了。
关于第二个问题，尝试下载一个Pro11.msi文件，如果还是不行的话，试一下修复 或重新安装。
Jaynet Zhang
TechNet Community Support
-
Hi,
先查看一下你的宏安全级别设定的是什么。如果您收到宏被禁用的错误消息，则可能是因为宏病毒防护的安全级别设置为了高安全级。要验证当前的安全级别，请按照以下步骤操作：
1.在“工具”菜单上，指向“宏”，然后单击“安全性”。
2.单击“安全级”选项卡。（将宏安全级别设置为“低”）
如果选择了“高”选项，请使用下列方法之一：
- 向宏添加数字签名。
- 获取带有数字签名的加载项。
- 信任所有已安装的加载项。
- 更改宏病毒防护的级别。
更多关于此报错的信息以及解决方案，可以参考以下链接：
http://support.microsoft.com/kb/316731/zh-cn
Jaynet Zhang
TechNet Community Support
