如何用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时，需勾选引用库。

点开发工具->工具->引用，勾选“Microsoft Excel 16.0 Object Library”

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

基本流程

插入形状

新建一页ppt，插入一个形状

插入按钮

点菜单栏->开发工具->“命令按钮”，在页面上拖动，插入按钮

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

点菜单栏->开始->选择->选择窗格，打开对象选择窗口

双击将矩形对象名，改名为shape_text，这就是VBA中关联的形状名

写代码

双击按钮，或点菜单栏->开发工具->查看代码，进入开发页面

写入如下代码，功能是在形状上显示一行文字

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页面

播放ppt，点击按钮，出现文字

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

将光标放到希望运行的函数内，点菜单栏运行按钮

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

部分关键代码

随机抽点：

Private Declare PtrSafe Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)

'开始
Sub RandomStart()
    F = 0
    Do While True
        If F = 1 Then Exit Do
        currentQuestionNum = Int(num3_5 * Rnd)
        Shapes("lable_text").TextFrame2.TextRange.Text = question3_5(currentQuestionNum, 0)
        Sleep 20
        DoEvents
    Loop
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 = i
    Shapes("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 Long

Private Function CreateTimer(ByVal Interval As Long) As Long
    ' 建立一个时间间隔为Interval微秒的定时器
    Dim tID As Long
    tID = SetTimer(0, 0, Interval, AddressOf TimerProc) '运行到此处出错
    CreateTimer = tID
End Function

Private 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中无解，也可能有更好的解决方法，欢迎交流。