简介：这是一份面向活动策划、课堂互动与小型抽奖场景的PPT名单抽取程序，以单个演示文稿承载VBA宏抽奖逻辑。压缩包内共1个ppt文件，体积约51KB，内置名单输入、开始/停止控制与滚动显示结果等交互，抽取时名单快速切换并即时呈现中选者，适合需要现场互动又不想额外部署软件的场合。程序依赖PPT中的VBA宏运行，代码围绕名单分割、随机索引、按钮状态切换和定时刷新展开，读者可据此理解随机抽取的实现方式，并按需调整名单分隔符、滚动节奏或扩展音效、动画等效果。目前已有3398人学习，适合想用轻量级演示文稿完成名单抽取的办公与教学用户参考。
1. 用 PPT 做年会抽奖：一个 UserForm 加三十行 VBA 就能跑的名单抽取程序
年会现场最怕什么？大屏卡在“正在连接服务器”。某次活动上，负责抽奖的同事抱着笔记本到处找网线，最后靠一份演示文稿救场——里面塞着一个 PPT 抽奖程序，按钮一按，名字在文本框里滚动，再按一下停住。这类基于演示文稿宏的名单抽取方案，好处是把抽奖逻辑、操作界面、投影画面塞进同一个文件，拷贝过去就能跑；代价是宏安全性、64 位兼容、放映状态下按钮点不动这些问题，得自己处理。它适合谁？适合需要临场改名单、没有后端、也不想装额外软件的活动执行同学，以及想拿一份能跑的小程序练手 VBA 的开发者。下面按工程结构、核心代码、从零搭建、避坑、二次开发的顺序拆。
2. 工程结构拆解：幻灯片、UserForm、标准模块各管一摊
这套程序在文件系统里看着只有一个文件，打开后却是三层分工。搞清楚哪段代码住在哪一层，后面改起来才不会在 VBA 编辑器里到处翻。
2.1 三层分工：画面、交互、逻辑
最外层是幻灯片本身，它只负责“看起来像抽奖”——大标题、背景图、装饰边框，可能还放一个“开始抽奖”的形状按钮。中间层是 UserForm，也就是那个带两个文本框和一个按钮的窗体，它负责接住用户输入、显示滚动结果、响应点击。最里层是标准模块和窗体代码背后的事件过程，负责切名单、摇随机数、控制循环节奏。
原程序里这三个控件的职责非常清晰：
| 控件 | 名称 | 职责 | 关键属性 |
|---|---|---|---|
| 文本框一 | TextBox1 | 参与名单输入，空格分隔 | MultiLine = True，WordWrap = True |
| 文本框二 | TextBox2 | 实时显示当前抽中的名字 | Locked = True，字号调大 |
| 命令按钮 | CommandButton1 | 开始/停止二合一 | Caption 在“开始”和“停”之间切换 |
把输入、输出、控制分成三个控件而不是挤在一个文本框里，是这份代码最值得学的一点：状态不互相污染，改名单的时候不会误伤结果区。我见过有人把名单和结果都写进 TextBox1，滚动时文本疯狂变长，几轮之后输入框直接卡死。
窗体本身建议设成非模态显示（Show vbModeless），原因在避坑章节展开——这是放映状态下能不能点按钮的关键。窗体标题设成“名单抽取”，宽度别太小，否则长名字会被截断；TextBox2 的 FontSize 直接拉到 36 以上，投影到大屏才看得清。
2.2 文件容器视角：宏到底存在哪
.pptm本质上是个 zip 容器，改成.zip后缀解开，能看到ppt/目录下有一堆幻灯片 XML，还有一个vbaProject.bin。所有 VBA 代码、UserForm 的二进制布局、控件属性都封在这个 bin 里。这意味着两件事：一是你把幻灯片删了、复制了、重排了，代码依然在；二是你把.pptm另存成.pptx，这个 bin 会被直接丢弃，打开后什么宏都没有。
所以工程里真正的“目录结构”是这样的：
ppt/slides/—— 幻灯片内容，只放视觉元素；ppt/vbaProject.bin—— 全部代码与窗体；- 文档属性里的宏启用标记 —— 决定打开时是否弹安全警告。
不建议手工解包去改 vbaProject.bin，一次改坏就全丢了。日常维护只在 VBA 编辑器（Alt+F11）里做，工程资源管理器里能看到VBAProject下面的Microsoft PowerPoint 对象、窗体、模块三组节点，改完保存就是一次完整的写盘。
2.3 为什么选它，边界又在哪
选演示文稿宏而不是网页或 Excel，核心理由是“现场交付形态”。抽奖必须投在大屏上，而大屏接的就是这台笔记本的投影输出，演示文稿天然占据全屏；网页要开浏览器、要处理全屏 API、要防止弹窗；Excel 虽然也能做大屏，但滚动名单的刷新观感不如窗体干净。
边界同样清楚：这套程序是单机、单文件、内存态。名单不落库，抽奖结果关掉文件就没了；没有并发控制，两个人同时点会打架；随机数质量也就那样，做娱乐用途够，做严肃摇号不够。知道自己站在哪，改起来才不会往错的方向堆功能。
3. 核心代码拆解：从按钮点击到名字滚动的完整链路
原程序总共三十来行，但信息密度不低。逐个变量、逐个参数拆一遍。
3.1 模块级声明：Sleep 与两个全局变量
' 引入系统动态库的 Sleep，用来做毫秒级停顿 Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long) ' arrRM 存切分后的名单数组，F 是停止标志位（0 继续，1 退出） Dim arrRM, FSleep是从系统动态库导入的外部函数，参数是毫秒。它做的是让当前线程真正挂起，不占用 CPU，比空循环For i = 1 To 100000那种“软件延时”干净得多。注意这里写的是Private Declare，作用域限于当前模块，不会污染其他窗体。
arrRM和F声明在模块顶部，意味着它们在窗体生命周期内一直存在。arrRM必须在“开始”时才重新赋值，因为用户可能在两轮之间改名单；F必须在每次开始时重置为 0，否则第二次点“开始”循环会立刻退出——这是新手改代码最容易破坏的一行。
3.2 按钮状态机：一个按钮干两件事
Private Sub CommandButton1_Click() ' 用按钮文字当状态标记，省掉一个额外的布尔变量 If Me.CommandButton1.Caption = "停" Then Me.CommandButton1.Caption = "开始" Call CQ_do("stop") Else Me.CommandButton1.Caption = "停" Call CQ_do("start") End If End Sub用一个按钮的Caption兼作状态位，是这个程序最“土”也最实用的设计。省掉一个isRunning变量，省掉一次同步，界面上还自带提示——用户看按钮文字就知道现在该点还是不该点。
代价是字符串比较有隐患：如果哪天你把按钮文字改成“停止”或加了空格，判断就永远不成立，点击只会一直往下走Else分支，表现为“点了没反应，名字一直在滚”。真要改文案，记得两处一起改，或者干脆换成模块级布尔量。
Call CQ_do("stop")走的是子程序调用，CQ_do是Private Sub，参数用Variant接收（声明时没写类型，默认就是 Variant），所以传字符串没问题。
3.3 CQ_do 的骨架：Split 切名单、Rnd 取下标、Sleep 控节奏
Private Sub CQ_do(doTag) Dim I If doTag = "start" Then ' 按空格切分名单；-1 表示不限个数，1 表示文本比较模式 arrRM = Split(Me.TextBox1, " ", -1, 1) F = 0 ' 重置停止标志 Do While True ' 死循环，靠 F 退出 Sleep 30 ' 每帧停 30 毫秒，约 33 帧/秒 ' Int(Rnd * n) 生成 0 到 n-1 的整数下标 I = Int(((UBound(arrRM) + 1) * Rnd) + 0) TextBox2.Text = arrRM(I) ' 刷新显示 If F = 1 Then Exit Do ' 停止信号在刷新之后检查 DoEvents ' 让出控制权，界面才会重绘 Loop Else F = 1 ' 只置标志，不硬中断 End If End SubSplit的四个参数是Split(表达式, 分隔符, 限制个数, 比较方式)。第三个-1表示返回全部元素，第四个1对应vbTextCompare，做文本比较，中文名单不受影响但大小写不敏感，属于顺手写对的一处。
UBound(arrRM) + 1是元素总数。因为Rnd返回值落在[0, 1)区间，乘上总数再取整，结果必然是0到n-1，正好覆盖数组全部下标，也不会越界。+ 0是冗余写法，删掉不影响结果。
Sleep 30决定了滚动的视觉速度。这个值不能太小，低于 15 毫秒人眼基本看不清单个名字；也不能太大，超过 200 毫秒会显得卡顿。30 是个舒服的甜点值。
F = 1的停止方式是“协作式退出”：停止请求只置标志，循环自己在下一轮检查到再退出。所以点“停”到真正停住之间，最多差一个Sleep周期。这就解释了一个常见现象——如果你嫌慢把Sleep调到 500，点停止后名字还会继续跳半秒才定格，现场看着像失灵。
3.4 DoEvents 与检查顺序：两处顺序都不能换
DoEvents的作用是把控制权短暂交还给系统，让 Windows 处理消息队列，界面才会真正重绘。如果不写这一行，循环会一直占着线程，TextBox2 的.Text赋值虽然在改，屏幕上却纹丝不动，直到循环结束才一次性显示最终结果——这就是很多人说的“界面假死”。
检查If F = 1 Then Exit Do放在刷新之后、DoEvents之前，意味着最后一次抽中的名字一定已经写进 TextBox2 才退出，不会出现“停了但结果还是上一个”的错位。如果把它挪到刷新前面，快速连点两次就有概率定格在旧值上。
另外注意Me.TextBox1和TextBox2.Text混用。在窗体代码里，不带Me.的控件名默认就指向当前窗体，两者等价。但如果在标准模块里写TextBox2.Text，编译直接报“变量未定义”——标准模块没有窗体上下文，必须写成UserForm1.TextBox2.Text。
4. 从零搭起来：新建 .pptm、摆控件、接宏、放映触发
拿到这段代码，怎么把它变成能在大屏上跑的成品，一步一步来。
4.1 建文件、插窗体、摆控件
第一步是格式。新建空白演示文稿后立刻“另存为”，类型选“启用宏的演示文稿”，后缀.pptm。这一步千万别省——先写成.pptx再回头改，保存时如果已经加了代码，会弹“无法保存 VBA 项目”的提示，很容易点错导致代码全丢。
第二步打开 VBA 编辑器。快捷键 Alt+F11。如果没反应，说明“开发工具”选项卡被隐藏了，去选项里把它勾出来。
第三步插入窗体：在 VBA 编辑器里“插入 → 用户窗体”，默认名字是UserForm1。然后从工具箱往窗体上拖两个文本框和一个命令按钮。属性窗口里做四件事：
UserForm1.Caption改为“名单抽取”；TextBox1.MultiLine = True，WordWrap = True，ScrollBars = 2（纵向滚动条），长名单才装得下；TextBox2.Locked = True，FontSize = 36，避免显示时被误改；CommandButton1.Caption = "开始"，字号也调大一点。
第四步双击那个按钮，进入代码窗口，把 3.1 到 3.4 的代码整段贴进去。注意模块顶部的Declare和Dim必须放在最上面、任何Sub之前，否则编译报“仅在模块级别有效”。
4.2 宏安全设置：低级别只是其中一条路
原程序要求在“工具 → 宏 → 安全性”里把级别调低。新版界面里这个入口挪到了“文件 → 选项 → 信任中心 → 信任中心设置 → 宏设置”，对应的是“启用所有宏（可能会运行有潜在危险的宏）”。调整之后要重启演示文稿才生效。
提示：直接开“启用所有宏”等于对所有来源的宏都放行，代价偏高。更稳妥的做法是“信任中心 → 受信任位置 → 添加新位置”，把这个 PPT 所在的文件夹加进去，同时勾选“同时信任此位置的子文件夹”。效果一样是免提示运行，但风险只暴露在你自己那个目录里。
还有一个容易忽略的点：从网上或聊天工具收到的文件，Windows 会打上“来自其他计算机”的锁定标记，即使放在受信任位置也可能仍被拦。右键文件 → 属性 → 勾选“解除锁定”即可。
4.3 放映状态下怎么触发
这是整套方案里最容易卡住的一环。放映模式下，幻灯片上的形状可以点击，但窗体上的按钮能不能点，取决于窗体是怎么显示的。UserForm1.Show默认是模态（vbModal），模态窗体在放映过程中会抢焦点，一显示就挡住了幻灯片，点确定关掉才继续——完全不能用。
正确写法是在标准模块里加一个入口：
' 标准模块：幻灯片上的形状动作指向这个宏 Public Sub 打开抽奖面板() If UserForm1.Visible = False Then UserForm1.Show vbModeless ' 关键：非模态，浮在放映画面上 End If End Sub然后在幻灯片上插入一个形状，右键“超链接/动作设置 → 运行宏”，选中打开抽奖面板。放映时点这个形状，窗体以非模态方式浮出来，按钮就能正常点了。
如果需要键盘触发，可以给形状配一个快捷键组合（比如 Ctrl+Shift+D），现场操作员不用瞄准鼠标。另外提醒一句：放映时把鼠标指针设成“自动隐藏”，避免光标停在名字上挡字。
4.4 上线前的一次彩排清单
代码跑通不等于现场能跑。我会在正式活动前把这几件事过一遍：
| 检查项 | 为什么 | 怎么验 |
|---|---|---|
| 名单首尾无空格、无连续空格 | 否则抽出空白项 | 在 TextBox1 末尾按 End 键看光标位置 |
| 名字总长度不撑爆 TextBox2 | 长名字换行后挤掉布局 | 塞一个二十字的名字试抽一次 |
| 停止有延迟但确实能停 | Sleep越大延迟越明显 | 连点两次开始/停，观察结果是否定格 |
| 投影分辨率下字号够大 | 1080p 和 4K 渲染差异大 | 切到实际投影，站三米外看 |
| 关闭文件后重开名单还在 | 文本框内容会随文件保存 | 存盘、关闭、重开、检查 |
| 笔记本断网、静音、关通知 | 弹窗会直接盖住大屏 | 飞行模式跑一遍 |
最后一条尤其重要。现场弹出系统更新提示、聊天软件消息，比代码崩溃更常见也更难看。真机彩排一次，比改十遍代码都值。
5. 避坑与排查：五个在现场翻过车的细节
下面这几条是实际跑的时候撞出来的，每条按现象、原因、解决走一遍。
5.1 一贴代码就报“必须更新此项目中的代码”
现象：在较新的 64 位办公环境里粘贴第一行Declare，立刻弹编译错误，说要在 64 位系统上更新代码。
原因：VBA 从 VBA7 开始要求外部函数声明加PtrSafe关键字，区分 32 位和 64 位指针宽度。老代码没有这个修饰，在 64 位宿主里直接不通过。
解决：用条件编译包一层，两种环境都能跑。
#If VBA7 Then ' 64 位与 32 位新宿主：必须加 PtrSafe Private Declare PtrSafe Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long) #Else Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long) #End IfSleep的参数是 32 位整数，Long在 VBA 里恒为 32 位，所以两种分支参数类型写法一致，只有PtrSafe的区别。
5.2 每次重开文件，抽奖顺序一模一样
现象：第一次抽，第三个名字中；关掉文件重开，还是第三个。
原因：Rnd用的是伪随机数，不显式初始化时种子固定，序列每次都从头来。原代码里没有Randomize。
解决：在开始抽奖的入口处调用一次Randomize Timer，用系统计时器当种子。注意放在CQ_do("start")分支的最前面，别放在循环里——放在循环里每帧都重置种子，反而会退化成可预测序列。
If doTag = "start" Then Randomize Timer ' 每次开始重新播种，序列不再重复 arrRM = Split(Me.TextBox1, " ", -1, 1) F = 0 ...顺带说，这种娱乐级抽奖不需要密码学强度的随机源，Rnd配合Timer播种完全够用；如果要做严肃摇号，得换成系统加密接口取随机字节，那是另一个量级的工程。
5.3 抽出来是空白，或者某几个人永远抽不到
现象：点了半天，TextBox2 里偶尔空一下；或者名单看着没问题，但滚动时总觉得少了人。
原因：Split不会压缩连续分隔符。"张三 李四"（中间两个空格）会切出三个元素，中间那个是空串；末尾多一个空格会切出最后一个空元素；从表格复制过来的名单还常带制表符和换行符，粘进去变成一个超长“名字”。
解决：切分前先做一遍清洗，把换行、制表符、中文逗号、顿号统一替换成空格，再把连续空格压成一个，最后Trim掉首尾。
' 把各种分隔符统一成单空格，再切分 Private Function CleanNames(raw As String) As String Dim s As String s = Replace(raw, vbCrLf, " ") s = Replace(s, vbTab, " ") s = Replace(s, "，", " ") s = Replace(s, "、", " ") Do While InStr(s, " ") > 0 ' 反复压，直到没有连续空格 s = Replace(s, " ", " ") Loop CleanNames = Trim(s) End Function调用处改成arrRM = Split(CleanNames(Me.TextBox1), " ", -1, 1)。这一行改动很小，但能消灭现场八成“抽出来是空的”事故。
5.4 放映时窗体不刷新，或者按钮完全点不动
现象：点了开始，名字不滚；或者滚起来了但点“停”没反应，只能按 Esc 退出放映。
原因有两种。一是漏了DoEvents，循环独占线程，界面收不到重绘消息，看着像死了。二是窗体用了默认的模态显示，放映时被挡在幻灯片后面或抢走焦点。
解决：循环里保证DoEvents一定执行；窗体统一用UserForm1.Show vbModeless显示。另外把Sleep的时长和停止响应绑定起来看——Sleep 30时停止几乎无感，Sleep 300时会有明显迟滞，如果一定要慢速滚动又想停得干脆，就把Sleep拆成多段小睡，每睡 20 毫秒检查一次F：
' 把一次长睡拆成若干小睡，停止响应更快 Dim k As Long For k = 1 To 10 Sleep 20 If F = 1 Then Exit For DoEvents Next k5.5 保存完再打开，代码和窗体全没了
现象：辛辛苦苦贴完代码，关掉重开，按 Alt+F11 进去空空如也。
原因：保存时选了.pptx，或者用了“另存为 → 演示文稿”这类不含宏的格式。VBA 工程只能存在.pptm、.ppsm、.potm这几种容器里。
解决：第一次保存就定死.pptm；后续所有“另存为”都检查一遍类型下拉框。养成习惯，改完代码先按 Ctrl+S，再看一眼标题栏的文件名后缀。另外别在放映状态下编辑代码，某些情况下退出放映会丢弃未保存的工程修改。
6. 二次开发：把“纯随机滚动”改成不放回抽样
原程序的抽取是独立同分布——每次都在完整名单里摇，同一个人可以被连续抽中三次。真要做多轮颁奖，这显然不行。
改造思路是把“随机取下标”换成“抽一个删一个”，用数组尾部元素填补被抽走的位置，池子每轮收缩一位，全程 O(1)，不用真的搬数据：
' 池子版抽取：抽中后从池中移除，天然不重复 Dim pool() As String, poolCount As Long Private Function DrawOne() As String Dim idx As Long If poolCount <= 0 Then DrawOne = "": Exit Function Randomize Timer idx = Int(Rnd() * poolCount) ' 只在剩余池里摇 DrawOne = pool(idx) pool(idx) = pool(poolCount - 1) ' 尾部元素补位 poolCount = poolCount - 1 ' 池子收缩 End FunctionpoolCount要在一轮开始时用清洗后的名单长度初始化，抽完记得把DrawOne的返回值追加到一个结果文本框里留痕——现场最常被问的就是“刚才抽的是谁”，没有记录只能重抽。节奏上我会把Sleep做成前快后慢：前 1 秒 20 毫秒一帧制造紧张感，之后逐帧加 5 毫秒直到 120 毫秒封顶，停下来的那一下观感比匀速滚好很多。
有一点必须提醒：pool数组是模块级变量，中途有人改了 TextBox1 里的名单，池子和输入就对不上了。所以我在每次start分支里都强制重建池子，绝不复用上一轮的状态。从那以后我每次改这类“带内存状态”的小工具，都强制走一遍“改名单 → 抽到底 → 再改名单 → 再抽”的完整闭环，宁可多按十次按钮，也不想在台上发现抽出来的人根本不在名单里。希望帮到你。
本文还有配套的精品资源，点击获取
