备忘录-10年前PPT自动答题小程序：完整代码一键复制，初级

一个PPT 内自动出题、随机抽题、答题、判分的完整小程序。可直接复制使用的最终完整版代码。分为两部分：（10年前的小工具，经过AI重新整理）

1. 标准模块（放通用过程：LoadTiKu）
2. 用户窗体模块（放按钮、控件事件）

一、标准模块（插入 → 模块）

模块名默认Module1即可

vba

' 全局数组：存放所有题目 Public AllTiMu() As Variant Sub LoadTiKu() Dim sFile As String Dim MyString As String Dim i As Integer Dim TiMu() As String i = 0 ReDim AllTiMu(0) ' 同目录下题库文件 sFile = ActivePresentation.Path & "\题库文件.txt" If Dir(sFile) = "" Then MsgBox "未找到题库文件：" & sFile, vbCritical Exit Sub End If Open sFile For Input Access Read As #1 Do While Not EOF(1) Line Input #1, MyString TiMu = Split(MyString, "|") AllTiMu(i) = TiMu i = i + 1 ReDim Preserve AllTiMu(i) Loop Close #1 Erase TiMu MsgBox "题库加载完成！共 " & i & " 道题目", vbInformation End Sub

二、用户窗体代码（直接粘贴到窗体代码窗口）

vba

' 窗体级公共变量 Public SelDaAn As String Public selIndex As Integer ' 加载试题 Private Sub cmdLoad_Click() ClearSel LoadTiKu MakeTiMu cmdLoad.Enabled = False End Sub ' 下一题 Private Sub cmdNext_Click() ClearSel MakeTiMu End Sub ' 核对答案 Private Sub cmdCheck_Click() If SelDaAn = "" Then MsgBox "请先选择一个选项！", vbExclamation Exit Sub End If If SelDaAn = AllTiMu(selIndex)(4) Then MsgBox "正确，继续努力！", vbInformation Else MsgBox "再考虑考虑！", vbCritical End If End Sub ' 随机出题 Private Sub MakeTiMu() Dim arrTemp() As String Dim totalTiMu As Integer Randomize totalTiMu = UBound(AllTiMu) If totalTiMu = 0 Then MsgBox "请先加载题库！", vbExclamation Exit Sub End If selIndex = Int(Rnd * totalTiMu) ' 显示题干 TextBox1.Text = "题目：" & AllTiMu(selIndex)(0) ' 选项 OptSelA.Caption = AllTiMu(selIndex)(1) OptSelB.Caption = AllTiMu(selIndex)(2) OptSelC.Caption = AllTiMu(selIndex)(3) OptSelD.Caption = AllTiMu(selIndex)(4) ' 重置选择 SelDaAn = "" End Sub ' 清空界面 Private Sub ClearSel() optSelA.Value = False optSelA.Caption = "" optSelB.Value = False optSelB.Caption = "" optSelC.Value = False optSelC.Caption = "" optSelD.Value = False optSelD.Caption = "" TextBox1.Text = "" SelDaAn = "" End Sub ' 选项A Private Sub optSelA_Click() SelDaAn = Left$(optSelA.Caption, 1) End Sub ' 选项B Private Sub optSelB_Click() SelDaAn = Left$(optSelB.Caption, 1) End Sub ' 选项C Private Sub optSelC_Click() SelDaAn = Left$(optSelC.Caption, 1) End Sub ' 选项D Private Sub optSelD_Click() SelDaAn = Left$(optSelD.Caption, 1) End Sub

三、题库文件格式（必须严格）

题库文件.txt一行一题，格式：

plaintext

题干|A选项|B选项|C选项|D选项|正确答案

示例：

plaintext

计算机中数据的最小单位是?|位(bit)|字节(Byte)|KB|MB|A PowerPoint中新建演示文稿快捷键是?|Ctrl+N|Ctrl+S|Ctrl+O|Ctrl+P|A

四、控件名称必须对应（否则报错）

• 加载按钮：cmdLoad
• 下一题按钮：cmdNext
• 核对答案按钮：cmdCheck
• 文本框：TextBox1
• 单选按钮：optSelA/optSelB/optSelC/optSelD

如果你需要，我可以再给你加：

• 答题计分（答对 + 1，答错 0）
• 禁止重复抽题
• 显示正确答案
• 答题完成后显示总分