PPT + Excel + VBA：一頁幻燈片實現無限題庫練習

痛點：傳統 PPT 練習 = N 道題做 N 頁，修改格式逐頁改，極其低效

解決方案：Excel 存題庫 + VBA 讀取數據填充單頁 PPT + 動作按鈕控制翻題/顯示答案。一頁 PPT 承載無限題目，修改樣式只改一頁。

準備工作

1. Excel Sheet1 建題庫：A 欄序號，B 欄題幹（含換行符），C 欄答案。檔名 book1.xls 與 PPT 同目錄。
2. PPT 插入空白頁 → 兩個文字框（題目框、答案框，答案框初始一空格）。
3. 插入 5 個動作按鈕：「開啟題庫」「上一題」「下一題」「正確答案」「關閉題庫」。

VBA 核心代碼（標準模組）

Public xlApp, xlBook, xlSheet
Public i As Integer

Sub 開啟題庫()
    Set xlApp = CreateObject("Excel.Application")
    xlApp.Visible = False
    Set xlBook = xlApp.Workbooks.Open(CurDir() & "\book1.xls")
    Set xlSheet = xlBook.Worksheets(1)
    i = 3 ' 假設第3行開始為數據
    Call 顯示當前題
End Sub

Sub 顯示當前題()
    ActivePresentation.Slides(1).Shapes(2).TextFrame.TextRange.Text = " "
    ActivePresentation.Slides(1).Shapes(1).TextFrame.TextRange.Text = _
        xlSheet.Range("a" & i) & "、" & Replace(xlSheet.Range("b" & i), Chr(10), Chr(13))
End Sub

Sub 下一題()
    i = i + 1
    If xlSheet.Range("a" & i) <> "" Then
        Call 顯示當前題
    Else
        MsgBox "已到最後一題了！"
    End If
End Sub

Sub 上一題()
    i = i - 1
    If xlSheet.Range("a" & i) <> "" And xlSheet.Range("a" & i) <> "序號" Then
        Call 顯示當前題
    Else
        MsgBox "已是第一題了！"
    End If
End Sub

Sub 正確答案()
    ActivePresentation.Slides(1).Shapes(2).TextFrame.TextRange.Text = xlSheet.Range("c" & i)
End Sub

Sub 關閉題庫()
    xlBook.Close False
    xlApp.Quit
    Set xlApp = Nothing
End Sub

按鈕綁定宏與安全性設定

1. 右鍵按鈕 →「動作設定」→「執行巨集」→ 選對應 Sub。
2. 「工具」→「巨集」→「安全性」→ 設為「低」（或「信任存取 Visual Basic 專案」）。

擴展性極強：題庫擴充只增 Excel 行數；樣式調整只改 PPT 文字框；還可加入計時、記分、錯題標記等邏輯。讓 PPT 從「展示工具」進化為「互動教學系統」。