如何用vba做答题、抽点类ppt

首先严重声明一下，我不是ppt高手，酷炫动画、美化之类一概不会，我只会写点代码，汇报ppt做得要多丑有多丑。

16年底，有幸拿到一份答题ppt模板，接手做了“XX知识问答竞赛”ppt，包含选题答题、倒计时、随机抽点等功能，初次接触到了VBA（Visual Basic for Applications）编程。

于是自那以后包办了单位各种答题类ppt……最近利用工作间隙又干了一票，感到是时候总结一下，把这项光荣而艰巨的任务传递下去了。

为了给ppt添加复杂功能，需要后台插入vba代码。下面整理一下为ppt插入、关联vba代码的基本流程，以及一些Bug的解决方法。

开发环境：Win10 x64，office 2016。

准备工作

显示“开发工具”

在菜单栏显示“开发工具”，方便后续开发。
打开ppt，点文件->选项->自定义功能区，勾选“开发工具”。

选择引用库

当需要读写Excel时，需勾选引用库。

注意：随office版本不同，16.0可能会变成12.0等，更换版本时（比如拿office 2010做的拷到office 2016的电脑上用）需要正确勾选。

基本流程

插入形状

插入按钮

打开选择窗格，为对象命名（很重要！）

写代码

Private Sub CommandButton1_Click()
Shapes("shape_text").TextFrame2.TextRange.Text = "你好，VBA！"
End Sub

关联代码

也可以为任何形状关联一段代码。需把代码片段声明中的“Private”关键字去掉，比如：

Sub Show()
Shapes("shape_text").TextFrame2.TextRange.Text = "你好，VBA！"
End Sub

然后回到ppt页面，为形状关联代码：

运行代码

方式一，播放ppt运行代码：

方式二，在开发页面直接运行代码（常用于调试）：

以上是ppt vba开发基本流程，下面附上部分代码。

部分关键代码

随机抽点：

Private Declare PtrSafe Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)'开始
Sub RandomStart()F = 0Do While TrueIf F = 1 Then Exit DocurrentQuestionNum = Int(num3_5 * Rnd)Shapes("lable_text").TextFrame2.TextRange.Text = question3_5(currentQuestionNum, 0)Sleep 20DoEventsLoop
End Sub'结束
Sub RandomStop()
F = 1
Shapes("shape_answer").Visible = msoTrue
End Sub

选题答题：

Sub chooseQuestion20(i As Integer)'题号消失Shapes(questionShape20(i)).TextFrame2.TextRange.Text = "" '出现"显示答案"按钮Shapes("shape_answer").Visible = msoTrue'显示题目currentQuestionNum = iShapes("lable_text").TextFrame2.TextRange.Text = question3_1(currentQuestionNum, 0)
End Sub

显示图片：

Shapes("pic1").Fill.UserPicture (ActivePresentation.Path & "\照片库\1.jpg")

各种疑难杂症

遇到过各种神奇的问题，网上对ppt vba方面问题解答较少，有些解决起来费了些功夫。

无法正常读取Excel

参考上文 “准备工作” “选择引用库” 。

出现“缺少Sub或Function”错误

这是在office2016上开发后，换到office2007电脑上运行报的错。

解决方法：尽量保持office版本一致，建议使用2010以上版本。

64位系统下，出现“类型不匹配”错误

从32位系统迁移到64位系统后，运行倒计时函数CreateTimer：

Private Declare PtrSafe Function SetTimer Lib "user32" (ByVal hWnd As _Long, ByVal nIDEvent As Long, ByVal uElapse As Long, _ByVal lpTimerFunc As Long) As LongPrivate Function CreateTimer(ByVal Interval As Long) As Long' 建立一个时间间隔为Interval微秒的定时器Dim tID As LongtID = SetTimer(0, 0, Interval, AddressOf TimerProc) '运行到此处出错CreateTimer = tID
End FunctionPrivate Sub TimerProc(ByVal hWnd As Long, ByVal Msg As Long, ByVal idEvent As Long, ByVal dwTime As Long)' 此处放入要执行的代码CounterNumber
End Sub

出现以下错误：

解决方法：将SetTimer声明的最后一个参数类型改为LongPtr，即指针类型即可。

Private Declare PtrSafe Function SetTimer Lib "user32" (ByVal hWnd As _Long, ByVal nIDEvent As Long, ByVal uElapse As Long, _ByVal lpTimerFunc As LongPtr) As Long

结语

没有系统学过VB，但由于是类C语言，在有源码的支撑下，比葫芦画瓢拿来用并不费力，当时从最初接触到完成开发只用了一周时间。

但至今仍有许多未解决的疑惑，例如：

如何将被点击形状的名称作为参数，使其被VBA代码捕获。目前为每个形状关联不同的函数，50个形状就要写50个函数、改50个名称、关联50次……；
如何随页面载入自动运行某段函数。目前采用手动点击按钮的方式初始化。

上述问题可能在ppt vba中无解，也可能有更好的解决方法，欢迎交流。