内容发布更新时间 : 2024/5/3 0:25:33星期一 下面是文章的全部内容请认真阅读。

最新【精品】范文 参考文献 专业论文

基于PPT环境下的VBA计时器设计研究

基于PPT环境下的VBA计时器设计研究

摘要：用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 \（ByVal hWnd As Long， ByVal nIDEvent As Long， ByVal uElapse As Long， ByVal lpTimerFunc As Long） As Long

Private Declare Function KillTimer Lib \（ByVal hWnd As Long， ByVal nIDEvent As Long） As Long

Private Declare Function timeGetTime Lib \（） 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（\＼ 60， 2） & \：\& Right（\， 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 '添加新菜单至最后