首先嚴(yán)重聲明一下，我不是ppt高手，酷炫動(dòng)畫、美化之類一概不會(huì)，我只會(huì)寫點(diǎn)代碼，匯報(bào)ppt做得要多丑有多丑。

16年底，有幸拿到一份答題ppt模板，接手做了“XX知識(shí)問答競(jìng)賽”ppt，包含選題答題、倒計(jì)時(shí)、隨機(jī)抽點(diǎn)等功能，初次接觸到了VBA（Visual Basic for Applications）編程。

于是自那以后包辦了單位各種答題類ppt……最近利用工作間隙又干了一票，感到是時(shí)候總結(jié)一下，把這項(xiàng)光榮而艱巨的任務(wù)傳遞下去了。

隨機(jī)抽點(diǎn)

選題答題，加減分

倒計(jì)時(shí)，并播放提示音

為了給ppt添加復(fù)雜功能，需要后臺(tái)插入vba代碼。下面整理一下為ppt插入、關(guān)聯(lián)vba代碼的基本流程，以及一些Bug的解決方法。

開發(fā)環(huán)境：Win10 x64，office 2016。

準(zhǔn)備工作

顯示“開發(fā)工具”

在菜單欄顯示“開發(fā)工具”，方便后續(xù)開發(fā)。
打開ppt，點(diǎn) 文件->選項(xiàng)->自定義功能區(qū)，勾選“開發(fā)工具”。

出現(xiàn)“開發(fā)工具”菜單

選擇引用庫

當(dāng)需要讀寫Excel時(shí)，需勾選引用庫。

點(diǎn)開發(fā)工具->工具->引用，勾選“Microsoft Excel 16.0 Object Library”

注意：隨office版本不同，16.0可能會(huì)變成12.0等，更換版本時(shí)（比如拿office 2010做的拷到office 2016的電腦上用）需要正確勾選。

基本流程

插入形狀

新建一頁ppt，插入一個(gè)形狀

插入按鈕

點(diǎn)菜單欄->開發(fā)工具->“命令按鈕”，在頁面上拖動(dòng)，插入按鈕

打開選擇窗格，為對(duì)象命名（很重要！）

點(diǎn)菜單欄->開始->選擇->選擇窗格，打開對(duì)象選擇窗口

雙擊將矩形對(duì)象名，改名為shape_text，這就是VBA中關(guān)聯(lián)的形狀名

寫代碼

雙擊按鈕，或點(diǎn)菜單欄->開發(fā)工具->查看代碼，進(jìn)入開發(fā)頁面

寫入如下代碼，功能是在形狀上顯示一行文字

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

關(guān)聯(lián)代碼

也可以為任何形狀關(guān)聯(lián)一段代碼。需把代碼片段聲明中的“Private”關(guān)鍵字去掉，比如：

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

然后回到ppt頁面，為形狀關(guān)聯(lián)代碼：

選中形狀，點(diǎn)菜單欄->插入->動(dòng)作->運(yùn)行宏

運(yùn)行代碼

方式一，播放ppt運(yùn)行代碼：

點(diǎn)擊菜單欄最左側(cè)按鈕，返回ppt頁面

播放ppt，點(diǎn)擊按鈕，出現(xiàn)文字

方式二，在開發(fā)頁面直接運(yùn)行代碼（常用于調(diào)試）：

將光標(biāo)放到希望運(yùn)行的函數(shù)內(nèi)，點(diǎn)菜單欄運(yùn)行按鈕

以上是ppt vba開發(fā)基本流程，下面附上部分代碼。

部分關(guān)鍵代碼

隨機(jī)抽點(diǎn)：

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

'結(jié)束
Sub RandomStop()
F = 1
Shapes("shape_answer").Visible = msoTrue
End Sub

選題答題：

Sub chooseQuestion20(i As Integer)
    '題號(hào)消失
    Shapes(questionShape20(i)).TextFrame2.TextRange.Text = "" 
    '出現(xiàn)"顯示答案"按鈕
    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")

各種疑難雜癥

遇到過各種神奇的問題，網(wǎng)上對(duì)ppt vba方面問題解答較少，有些解決起來費(fèi)了些功夫。

無法正常讀取Excel

參考上文 “準(zhǔn)備工作” “選擇引用庫” 。

出現(xiàn)“缺少Sub或Function”錯(cuò)誤

這是在office2016上開發(fā)后，換到office2007電腦上運(yùn)行報(bào)的錯(cuò)。

解決方法：盡量保持office版本一致，建議使用2010以上版本。

64位系統(tǒng)下，出現(xiàn)“類型不匹配”錯(cuò)誤

從32位系統(tǒng)遷移到64位系統(tǒng)后，運(yùn)行倒計(jì)時(shí)函數(shù)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
    ' 建立一個(gè)時(shí)間間隔為Interval微秒的定時(shí)器
    Dim tID As Long
    tID = SetTimer(0, 0, Interval, AddressOf TimerProc) '運(yùn)行到此處出錯(cuò)
    CreateTimer = tID
End Function

Private Sub TimerProc(ByVal hWnd As Long, ByVal Msg As Long, ByVal idEvent As Long, ByVal dwTime As Long)
    ' 此處放入要執(zhí)行的代碼
    CounterNumber
End Sub

出現(xiàn)以下錯(cuò)誤：

解決方法：將SetTimer聲明的最后一個(gè)參數(shù)類型改為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

結(jié)語

沒有系統(tǒng)學(xué)過VB，但由于是類C語言，在有源碼的支撐下，比葫蘆畫瓢拿來用并不費(fèi)力，當(dāng)時(shí)從最初接觸到完成開發(fā)只用了一周時(shí)間。

但至今仍有許多未解決的疑惑，例如：

1. 如何將被點(diǎn)擊形狀的名稱作為參數(shù)，使其被VBA代碼捕獲。目前為每個(gè)形狀關(guān)聯(lián)不同的函數(shù)，50個(gè)形狀就要寫50個(gè)函數(shù)、改50個(gè)名稱、關(guān)聯(lián)50次……；
2. 如何隨頁面載入自動(dòng)運(yùn)行某段函數(shù)。目前采用手動(dòng)點(diǎn)擊按鈕的方式初始化。

上述問題可能在ppt vba中無解，也可能有更好的解決方法，歡迎交流。