PPT实现倒计时功能(VBA实现)

在 “工具”/“自定义” 里，找到 “工具拦” 选项卡，找到“控件和工具箱”，将前面打钩。

在一张幻灯片上拖个 按钮 和 文本框。

双击 按钮，打开代码窗口

输入：

 

view plain copy to clipboard print ?

1. Private Sub CommandButton1_Click()  
2.     win_hwnd = GetActiveWindow()  
3.     TextBox1.Text = "10"  
4.     SetTimer win_hwnd, 101, 1000, AddressOf timer  
5. End Sub  
6.   
7. Private Sub TextBox1_Change()  
8.     If TextBox1.Text <= 0 Then  
9.         KillTimer win_hwnd, 101  
10.         MsgBox "Time Up!", vbInformation, "T_T"  
11.     End If  
12. End Sub  

 

再在里面添加一个模块，输入：

 

view plain copy to clipboard print ?

1. Public Declare Function GetActiveWindow Lib "user32" () As Long  
2. Public Declare Function SetTimer Lib "user32" (ByVal hwnd As Long, _  
3.     ByVal nIDEvent As Long, ByVal uElapse As Long, ByVal lpTimerFunc As Long) As Long  
4. Public Declare Function KillTimer Lib "user32" (ByVal hwnd As Long, _  
5.     ByVal nIDEvent As Long) As Long  
6.   
7. Public win_hwnd As Long  
8.   
9. Public Sub timer()  
10.     Slide1.TextBox1.Text = Val(Slide1.TextBox1.Text) - 1  
11. End Sub  

 

关闭代码窗口

开始放映幻灯片，点 按钮，好了开始计时了