论文部分内容阅读
摘要：用PPT制作的课件被广泛应用，在PPT中应用计时器有很多的解决方案。文本使用VBA研究设计了计时器，计时器可以方便的应用于整个PPT环境，时间调节灵活，可以适应更广泛的需求。
关键词：计时器 VBA 类 模块 宏
引言
PPT是使用最广泛的课件制作软件，广泛地应用于各种演讲、教学、比赛中，使用VBA制作倒计时器，这样很好地控制现场时间。
介面设计
在PPT中按Alt+F11键进入VBE，打开工程窗口。在VBAProject（演示文稿1）工程中，分别插入2个窗口、1个模块、1个类模块。如图1。
类1及窗体代码：
双击“类1”，然后在打开的类代码窗口中输入下面的程序：
Public WithEvents App As Application
Private Sub App_SlideShowBegin（ByVal Wn As SlideShowWindow）
If ActivePresentation.SlideShowWindow.View.CurrentShowPosition = 1 And apply Then
UserForm1.Show 0 ： StartTimer 1000 ： End If ： End Sub
Private Sub App_SlideShowEnd（ByVal Pres As Presentation）
StopTimer （TimerID） ： Unload UserForm1
End Sub
（1）对UserForm1窗口，设置好相关窗体属性，如图2所示。双击标签控件，输入程序代码：
Private Sub UserForm_Activate（）
Rem 右下角 ： Me.Left = Application.Width - Me.Width ： Me.Top = Application.Height ： Do
Me.Top = Me.Top – 2 ： Delay 1： Loop Until Me.Top < Application.Height - Me.Height
End Sub
（2）在UserForm2窗体中，设置如图3所示的介面。包括：2个命令按钮、2个标签控件、2个旋转按钮。
程序代码为：
Private Sub CommandButton1_Click（）
apply = True ： TimeCount = TextBox1.Value * 60 + TextBox2.Value ： SaveConfig ： Unload Me
End Sub
Private Sub CommandButton2_Click（）
Unload Me
End Sub
Private Sub SpinButton1_Change（）
TextBox1.Value = SpinButton1.Value
End Sub
Private Sub SpinButton2_Change（）
TextBox2.Value = SpinButton2.Value
End Sub
Private Sub UserForm_Initialize（）
TextBox1.Value = TimeCount ＼ 60 ： TextBox2.Value = TimeCount Mod 60
SpinButton1.Value = TimeCount ＼ 60 ： SpinButton2.Value = TimeCount Mod 60
End Sub
0 模块1程序代码：
Option Explicit
Public AutoApp As New 类1 ： Public WshShell， bKey
Public nTime As Integer， TimerID As Long ： Public apply As Boolean
Public TimeCount As Integer， EndEvent As Integer
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 KillTimer Lib "user32" （ByVal hWnd As Long， ByVal nIDEvent As Long） As Long
Private Declare Function timeGetTime Lib "winmm.dll" （） As Long
Public Sub Delay（ByVal num As Integer） '延时
Dim t As Long ： t = timeGetTime ： Do Until timeGetTime - t >= num * 50 '精度
DoEvents ： Loop
End Sub Private Sub TimerProc（ByVal lHwnd As Long， ByVal lMsg As Long， ByVal lTimerId As Long， ByVal lTime As Long）
UserForm1.Label1 = Right（"0" & nTime ＼ 60， 2） & "：" & Right（"0" & nTime Mod 60， 2）
nTime = nTime – 1 ： If nTime < 0 Then ： StopTimer TimerID
ActivePresentation.SlideShowWindow.View.Last
ActivePresentation.SlideShowWindow.View.Next ： End If
End Sub
Public Sub StartTimer （minutes As Long）
nTime = TimeCount ： TimerID = SetTimer（0， 0， lMinute， AddressOf TimerProc）
End Sub
Public Function StopTimer（lTimerId As Long） As Long
StopTimer = KillTimer（0， lTimerId）
End Function
Sub Auto_Open（）
Dim NewMenu As CommandBarPopup
Dim MenuItem1 As CommandBarControl '添加新菜单至最后
On Error Resume Next '如果菜单已存在，则删除该菜单
CommandBars（"Menu Bar"）.Controls（"倒计时"）.Delete
Set NewMenu = CommandBars（"Menu Bar"）.Controls.Add（Type：=msoControlPopup， Temporary：=True）
NewMenu.Caption = "倒计时"
'添加第一个菜单项
Set MenuItem1 =NewMenu.Controls.Add（Type：=msoControlButton）
With MenuItem1
.Caption = "设置..." ： .FaceId = 1 ： .OnAction = "MenuItem1_Click"
End With
Set AutoApp.App = Application ： Init ： End Sub
Private Sub Init（）
Set WshShell = CreateObject（"WSCRIPT.SHELL"） ： On Error Resume Next
apply = WshShell.RegRead（"HKEY_CURRENT_USER＼pptcountdown＼apply"）
If Err.Number <> 0 Then '如果没有发现值，则创建
DefaultValue ： Else ： GetConfigValue ： End If
End Sub
Public Sub DefaultValue（）
apply = True ： TimeCount = 900 '默认倒计时间15分钟
SaveConfig
End Sub
Private Sub GetConfigValue（）
apply = WshShell.RegRead（"HKEY_CURRENT_USER＼pptcountdown＼apply"）
TimeCount = 900
End Sub
Public Sub SaveConfig（）
WshShell.RegWrite "HKEY_CURRENT_USER＼pptcountdown＼apply"， apply， "REG_SZ"
WshShell.RegWrite "HKEY_CURRENT_USER＼pptcountdown＼TimeCount"， TimeCount， "REG_DWORD"
End Sub
Public Sub MenuItem1_Click（）
UserForm2.Show
End Sub
一、生成PPT宏文件
退出VBE并返回到幻灯片中，单击【文件】|【另存为】，在“保存类型”框中选择“PPT 加载宏（*.ppa）”，在“文件名框”为宏取名为：“倒计时”。
这样就产生了一个文件：“倒计时.ppa”。以后使用时，双击该文件即可启动倒计时宏。您也可以在PPT中，通过单击【工具】|【加载宏】，来添加或删除宏。
二、启动加裁宏
将PPT宏安全性调整为中或低，以便能启用宏。然后双击启动“倒计时.ppa”，如果有安全提示，请按“确定”，即可看到“倒计时”菜单项。
三、注意事项
要使得ppa加载宏在VBE中可见，在PPT没有启动的情况下，修改注册表：
在HKEY_CURRENT_USER＼Software＼Microsoft＼Office＼10.0＼PPT＼Options下（10.0为版本值，可以不同）。
在右边名称窗中右击：新建DWORD值（或修改），命名为“DebugAddins”，双击新建的DebugAddins，出现编辑双字节值（DWORD）的窗口，设置数值数据为1，关闭注册表。
四、结语
本文所设计的计时器，其功能还可以进一步扩充，例如加入倒计时提醒、出现位置的设置及提示音乐等功能。如果在出现的计时和设置介面中加入丰富的图片等效果，可以使程序功能更丰富，介面更美观。
参考文献
1.Evangelos Petroutsos MASTERRING Microsoft? Visual Basic 2008， Copyright ? 2008 by Wiley Publishing， Inc.， Indiana Published simultaneously in Canada， ISBN： 978-4701-8742-5
2.（美）（K.盖茨）Ken Getz，（美）（M.吉尔伯特）Mike Gilbert著；邱仲潘等译. VBA高级开发指南.
3.Anderson T. Office 2003 programming ： real world applications.：Computing Reviews，2005 May 24
作者简介：孙传庆（1964–），男，山东章丘人，教授，主要从事计算机教学应用及其研究。省内大专院校科研项目：2013-JY-41、2013-JY-/24）
关键词：计时器 VBA 类 模块 宏
引言
PPT是使用最广泛的课件制作软件，广泛地应用于各种演讲、教学、比赛中，使用VBA制作倒计时器，这样很好地控制现场时间。
介面设计
在PPT中按Alt+F11键进入VBE，打开工程窗口。在VBAProject（演示文稿1）工程中，分别插入2个窗口、1个模块、1个类模块。如图1。
类1及窗体代码：
双击“类1”，然后在打开的类代码窗口中输入下面的程序：
Public WithEvents App As Application
Private Sub App_SlideShowBegin（ByVal Wn As SlideShowWindow）
If ActivePresentation.SlideShowWindow.View.CurrentShowPosition = 1 And apply Then
UserForm1.Show 0 ： StartTimer 1000 ： End If ： End Sub
Private Sub App_SlideShowEnd（ByVal Pres As Presentation）
StopTimer （TimerID） ： Unload UserForm1
End Sub
（1）对UserForm1窗口，设置好相关窗体属性，如图2所示。双击标签控件，输入程序代码：
Private Sub UserForm_Activate（）
Rem 右下角 ： Me.Left = Application.Width - Me.Width ： Me.Top = Application.Height ： Do
Me.Top = Me.Top – 2 ： Delay 1： Loop Until Me.Top < Application.Height - Me.Height
End Sub
（2）在UserForm2窗体中，设置如图3所示的介面。包括：2个命令按钮、2个标签控件、2个旋转按钮。
程序代码为：
Private Sub CommandButton1_Click（）
apply = True ： TimeCount = TextBox1.Value * 60 + TextBox2.Value ： SaveConfig ： Unload Me
End Sub
Private Sub CommandButton2_Click（）
Unload Me
End Sub
Private Sub SpinButton1_Change（）
TextBox1.Value = SpinButton1.Value
End Sub
Private Sub SpinButton2_Change（）
TextBox2.Value = SpinButton2.Value
End Sub
Private Sub UserForm_Initialize（）
TextBox1.Value = TimeCount ＼ 60 ： TextBox2.Value = TimeCount Mod 60
SpinButton1.Value = TimeCount ＼ 60 ： SpinButton2.Value = TimeCount Mod 60
End Sub
0 模块1程序代码：
Option Explicit
Public AutoApp As New 类1 ： Public WshShell， bKey
Public nTime As Integer， TimerID As Long ： Public apply As Boolean
Public TimeCount As Integer， EndEvent As Integer
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 KillTimer Lib "user32" （ByVal hWnd As Long， ByVal nIDEvent As Long） As Long
Private Declare Function timeGetTime Lib "winmm.dll" （） As Long
Public Sub Delay（ByVal num As Integer） '延时
Dim t As Long ： t = timeGetTime ： Do Until timeGetTime - t >= num * 50 '精度
DoEvents ： Loop
End Sub Private Sub TimerProc（ByVal lHwnd As Long， ByVal lMsg As Long， ByVal lTimerId As Long， ByVal lTime As Long）
UserForm1.Label1 = Right（"0" & nTime ＼ 60， 2） & "：" & Right（"0" & nTime Mod 60， 2）
nTime = nTime – 1 ： If nTime < 0 Then ： StopTimer TimerID
ActivePresentation.SlideShowWindow.View.Last
ActivePresentation.SlideShowWindow.View.Next ： End If
End Sub
Public Sub StartTimer （minutes As Long）
nTime = TimeCount ： TimerID = SetTimer（0， 0， lMinute， AddressOf TimerProc）
End Sub
Public Function StopTimer（lTimerId As Long） As Long
StopTimer = KillTimer（0， lTimerId）
End Function
Sub Auto_Open（）
Dim NewMenu As CommandBarPopup
Dim MenuItem1 As CommandBarControl '添加新菜单至最后
On Error Resume Next '如果菜单已存在，则删除该菜单
CommandBars（"Menu Bar"）.Controls（"倒计时"）.Delete
Set NewMenu = CommandBars（"Menu Bar"）.Controls.Add（Type：=msoControlPopup， Temporary：=True）
NewMenu.Caption = "倒计时"
'添加第一个菜单项
Set MenuItem1 =NewMenu.Controls.Add（Type：=msoControlButton）
With MenuItem1
.Caption = "设置..." ： .FaceId = 1 ： .OnAction = "MenuItem1_Click"
End With
Set AutoApp.App = Application ： Init ： End Sub
Private Sub Init（）
Set WshShell = CreateObject（"WSCRIPT.SHELL"） ： On Error Resume Next
apply = WshShell.RegRead（"HKEY_CURRENT_USER＼pptcountdown＼apply"）
If Err.Number <> 0 Then '如果没有发现值，则创建
DefaultValue ： Else ： GetConfigValue ： End If
End Sub
Public Sub DefaultValue（）
apply = True ： TimeCount = 900 '默认倒计时间15分钟
SaveConfig
End Sub
Private Sub GetConfigValue（）
apply = WshShell.RegRead（"HKEY_CURRENT_USER＼pptcountdown＼apply"）
TimeCount = 900
End Sub
Public Sub SaveConfig（）
WshShell.RegWrite "HKEY_CURRENT_USER＼pptcountdown＼apply"， apply， "REG_SZ"
WshShell.RegWrite "HKEY_CURRENT_USER＼pptcountdown＼TimeCount"， TimeCount， "REG_DWORD"
End Sub
Public Sub MenuItem1_Click（）
UserForm2.Show
End Sub
一、生成PPT宏文件
退出VBE并返回到幻灯片中，单击【文件】|【另存为】，在“保存类型”框中选择“PPT 加载宏（*.ppa）”，在“文件名框”为宏取名为：“倒计时”。
这样就产生了一个文件：“倒计时.ppa”。以后使用时，双击该文件即可启动倒计时宏。您也可以在PPT中，通过单击【工具】|【加载宏】，来添加或删除宏。
二、启动加裁宏
将PPT宏安全性调整为中或低，以便能启用宏。然后双击启动“倒计时.ppa”，如果有安全提示，请按“确定”，即可看到“倒计时”菜单项。
三、注意事项
要使得ppa加载宏在VBE中可见，在PPT没有启动的情况下，修改注册表：
在HKEY_CURRENT_USER＼Software＼Microsoft＼Office＼10.0＼PPT＼Options下（10.0为版本值，可以不同）。
在右边名称窗中右击：新建DWORD值（或修改），命名为“DebugAddins”，双击新建的DebugAddins，出现编辑双字节值（DWORD）的窗口，设置数值数据为1，关闭注册表。
四、结语
本文所设计的计时器，其功能还可以进一步扩充，例如加入倒计时提醒、出现位置的设置及提示音乐等功能。如果在出现的计时和设置介面中加入丰富的图片等效果，可以使程序功能更丰富，介面更美观。
参考文献
1.Evangelos Petroutsos MASTERRING Microsoft? Visual Basic 2008， Copyright ? 2008 by Wiley Publishing， Inc.， Indiana Published simultaneously in Canada， ISBN： 978-4701-8742-5
2.（美）（K.盖茨）Ken Getz，（美）（M.吉尔伯特）Mike Gilbert著；邱仲潘等译. VBA高级开发指南.
3.Anderson T. Office 2003 programming ： real world applications.：Computing Reviews，2005 May 24
作者简介：孙传庆（1964–），男，山东章丘人，教授，主要从事计算机教学应用及其研究。省内大专院校科研项目：2013-JY-41、2013-JY-/24）