用VBA在PowerPoint中实现日期时间秒级动态显示
'*********************************************************** 使用说明 *********************************************************
'把此文本写入PowerPoint的VBA的宏里面，然后把PPT保存为PPT的ppam文件，在PPT“开发工具”里加载项中添加该ppam文件。
'PowerPoint需要的设置：
' 1、文件/选项/信任中心/信任中心设置/启用所有宏。
' 2、开发工具/加载项/添加，加入上述ppam文件。
'以后，只要在某个幻灯片中插入文本框TimeText，那么该文本框就会显示当前日期时间。
'*******************************************************************************************************************************
'***************** 定义与声明 ****************
#If VBA7 Or Win64 Then
Declare PtrSafe Function SetTimer Lib "user32" (ByVal hwnd As Long, ByVal nIDEvent As Long, ByVal uElapse As Long, ByVal lpTimerFunc As LongPtr) As Long
Declare PtrSafe Function KillTimer Lib "user32" (ByVal hwnd As Long, ByVal nIDEvent As Long) As Long
#Else
Declare Function SetTimer Lib "user32" (ByVal hwnd As Long, ByVal nIDEvent As Long, ByVal uElapse As Long, ByVal lpTimerFunc As LongPtr) As Long
Declare Function KillTimer Lib "user32" (ByVal hwnd As Long, ByVal nIDEvent As Long) As Long
#End If
Public index As Integer
Public temp As Shape
Public ID As Integer
Public SlideNO As Integer
'***************** 计时器 ********************
Public Sub TimerProc(ByVal hwnd As Long, ByVal uMsg As Long, ByVal idEvent As Long, ByVal dwTime As Long)
temp.TextFrame.TextRange.Text = Format(Date, "YYYY.MM.DD") & " " & Format(Time, "HH:MM:SS")
End Sub
'************* 放映时显示日期时间 **************
Public Sub OnSlideShowPageChange()
SlideNO = ActivePresentation.SlideShowWindow.View.CurrentShowPosition
If Not ActivePresentation.Slides(SlideNO).Shapes("TimeText") Is Nothing Then
If ID > 0 Then
temp.TextFrame.TextRange.Text = ""
tt = KillTimer(0, ID)
ID = 0
End If
If ID <= 0 Then
ID = SetTimer(win_hwnd, 1000, 1000, AddressOf TimerProc)
Set temp = ActivePresentation.Slides(SlideNO).Shapes("TimeText")
temp.ZOrder (msoBringToFront)
temp.TextFrame.TextRange.Text = ""
Else
temp.TextFrame.TextRange.Text = ""
End If
End If
End Sub
'************** 结束放映时处理 ****************
Public Sub OnSlideShowTerminate()
tt = KillTimer(0, ID)
ID = 0
ActivePresentation.Saved = msoTrue
End Sub
最新文章
- 学习linux之用mail命令发邮件
- POJ2186 Popular Cows [强连通分量|缩点]
- lock模拟CountDownEvent
- 用Visual Studio 2012+Xamarin搭建C#开发Andriod的环境
- WINRARA 排除 .svn 文件夹
- android学习笔记43——图形图像处理3——Path
- 求字符串的最长回文字串 O(n)
- 《Cortex-M0权威指南》之体系结构---系统模型
- Unslider--使用手册系列（一）
- Linux常用命令及vim的使用、vim常用插件（推荐）
- Postman newman
- html5的在ie6，7，8兼容
- 第一次QQ群视频教育有感
- 支付宝app支付服务器签名代码(C#)
- PHP简单分页省略中间页码
- java后台验证码工具
- lodash源码分析之去重--uniq方法
- Threading.Timer用法
- 3.11formdata的使用
- checkbox选中相关问题总结