本篇的目的以及需要解决的问题：

已知错误的分析和排查

如何一次抽取多名获奖者

把抽奖PPT修改成“一页抽一个奖项”(像篇一的头图那样)

如何把篇一中的白底文本框变成透明文本框

简单探讨如何把某一奖项指定给某一个人或某几个人

目前来看，大家碰到最多的问题是“Cannot find the name list file”，当然主要原因是我的代码不够严谨或者说容错机制不够。

文件名中包含“.txt”导致跟扩展名组成了“.txt.txt”

有时候我们的系统设置了“隐藏扩展名”，所以在保存这个namelist.txt的时候要注意选择“所有文件 (*.*)”，有些人可能习惯在桌面上右击新建一个文本文件再重命名，在隐藏扩展名的情况下，重命名应该改成“namelist”而不是“namelist.txt”，因为后一种情况下，它的实际文件名就是“namelist.txt.txt”导致找不到文件了。

抽奖PPT所在的完整路径中包含抽奖PPT的名称

听起来有点绕，举个例子。比如你的抽奖PPT名称是“2019年会抽奖.ppt”，然后它所在的目录是“D:2019年会抽奖.ppt”，换句话说它的完整路径是“D:Working2019年会抽奖.ppt2019年会抽奖.ppt”，这种情况下也会报找不到namelist.txt，因为在代码里使用了下面这段高亮的代码，程序会去尝试寻找“D:Workingnamelist.txtnamelist.txt”这个文件，当然就会报错了。解决的办法就是——确保抽奖PPT所在的目录结构中，没有哪一层目录名称包含PPT名称(含扩展名)。

OneDriver同步目录中的抽奖PPT

这是一个比较奇怪的现象，如果你使用Office 365套件或者OneDriver个人版，把抽奖PPT放到一个被同步到OneDriver云端的目录中，会无法获取正确的“ActivePresentation.FullName”属性，也会导致寻找namelist.txt失败。在这种情况下，“ActivePresentation.FullName”可能是一个网络路径，具体我也没去细细研究，只要知道解决办法就行了——把抽奖PPT和namelist.txt放到一个没有被同步到OneDriver的目录。换句话说，如果它们已经在OneDriver目录里了，把它们拷贝到另一个本地目录就行了。

用户定义类型未定义”的编译错误。

这种情况都是看文章不认真导致的

最后还要添加一个引用项，点击VBA窗口的菜单“工具引用”，勾选“Microsoft ing Runtime”，然后点击确定。

最后还要添加一个引用项，点击VBA窗口的菜单“工具引用”，勾选“Microsoft ing Runtime”，然后点击确定。

我暂时能想到的常见错误就这些了，如果还有其它的可以在评论区提出。另外还有一点需要注意——Office里面的VBA部分还是有点bug的，而且这种bug相对来说比较难调试，所以有两个建议：

确保在最终运行该抽奖PPT的电脑上进行抽奖PPT的制作和调试，千万不要在电脑A(Office版本a)上制作，然后到电脑B(Office版本b)上面去运行，电脑之间的差异可能无关紧要，但不同版本的Office之间很可能有意想不到的差异。

在保证上述第1条的前提下，尽可能使用最新版本的Office。

在保证上述2条的前提下，尽可能使用最新的文件格式(如.pptm)，不要选择兼容模式。

在具体实现之前，让我们先把篇一中的基础功能版抽奖PPT做一些小的调整。首先，现在很多的电子屏幕都是16:9的宽屏了，为了投屏的时候有更好的效果，把PPT的页面调整为16:9。然后，再换一个合适的背景图片。最后再把控件的位置稍微调整一下。最终得到这样一样基础版PPT，本文的所有改动都基于这个基础版。

事实上在下图中的这个方法中本来就留有“一次获取多个随机值”的接口，只要给它传一个参数即可。比如一次抽取5名，则调用这个方法的时候用GetRandomString(5)，它的返回是由逗号分隔的5个随机值组成的字符串。

具体来说，修改代码段C，改成这样。

因为上面修改了LoopString的调用方法，所以还要修改LoopString方法。找到代码段E，改成这样。

需要注意的是，这样修改之后，理论上“缺席”按钮已经不能再用了，因为现实中不太可能出现“5个人同时缺席”这种情况，但如果非得让逻辑正确的话，可以把代码段G作如下修改。

经过以上修改，就实现了“每次抽取5名获奖者”的功能。如果觉得名单中的逗号不太好看，可以使用Replace方法把逗号替换成空格或者换行符。具体用法可参考代码段J。

把抽奖PPT修改成“一页一奖项”

现实中我们可能希望不同的奖项在不同的页面上显示，这样可以给各奖项定制背景图片，更重要的是可以自定义每个奖项每次抽取的数量。比如，五等奖每次抽5名，四等奖每次抽3名，而三等奖、二等奖及一等奖都是每次抽取1名。那么如何实现呢？请接着往下看。

首先我们假定所有奖项如下：

五等奖，20名，每次抽取5名

四等奖，15名，每次抽取3名

三等奖，10名，每次抽取1名

二等奖，5名，每次抽取1名

一等奖，2名，每次抽取1名

五等奖，20名，每次抽取5名

四等奖，15名，每次抽取3名

三等奖，10名，每次抽取1名

二等奖，5名，每次抽取1名

一等奖，2名，每次抽取1名

首先当然是修改代码段I的内容，把奖项设置好。设置好以后播放幻灯片并按一次“重置”按钮，使奖项设置生效。

小提示：事实上如果我们把抽奖PPT做成一页一奖项的形式，这里也不再需要为单页设置这么多的奖项。如果通过修改上图中红框内的3部分，让它只保留当前页面所需要奖项，可以避免后续按了“重置”按钮之后还要为每一页选择奖项的操作。比如在五等奖页面的代码中，只需要保留“五等奖”、“20”和“0”就可以了。

小提示：事实上如果我们把抽奖PPT做成一页一奖项的形式，这里也不再需要为单页设置这么多的奖项。如果通过修改上图中红框内的3部分，让它只保留当前页面所需要奖项，可以避免后续按了“重置”按钮之后还要为每一页选择奖项的操作。比如在五等奖页面的代码中，只需要保留“五等奖”、“20”和“0”就可以了。

然后，通过右击幻灯片选择“复制幻灯片”，把这一页幻灯片复制4份(即一共5页)。为了方便后续识别，我在每一页幻灯片的右下角写上“一等奖”、“二等奖”等字样。

接下来我们进入幻灯片放映模式，并从每一页的下拉列表中选择对应的奖项(参照上文“小提示”部分可以避免选择对应奖项这一步操作)。

然后，参照上文“如何一次抽取多名获奖者”章节，把四等奖的页面改成一次抽取3名(所涉及到的数字5改成3)，再把三等奖、二等奖和一等奖的页面恢复成1次抽取1名(所涉及到的数字5改成1)。修改的时候要注意一下幻灯片编号(如下图中的Slide25)跟实际奖项页之间的对应关系。

这样修改完之后，基本上就实现了“一页一奖项”的功能。试着运行一遍，可以看到各奖项之间是“互斥”的，因此到最后一页一等奖的时候，名单只剩下一个人，就不再滚动了。但是，如果你把所有页都恢复原样(按“重置”按钮，再从下拉列表选择对应选项)之后保存PPT再重新打开，你会发现各奖项之类又变成“不互斥”了。这是怎么回事呢？(下面两个动图，上图奖项互斥，下图奖项不互斥)

原来，保存之后再重新打开PPT，虽然从界面上看没发生任何变化，但实际上每页的下拉框控件的状态被重置了，这个状态，只有在你按下那个下拉箭头的时候才会被初始化。换句话说，你把一切都设置好了，然后保存了抽奖PPT，在需要使用的时候再把这个PPT打开并开始抽奖，那么这些奖项是不互斥的。那么如果想要互斥怎么办呢？很简单，只要把对应页的代码中的InitComboBox1()方法稍微修改一下即可——把RefreshDic修改成ReadNameList。

这样修改的原理是什么呢？事实上只要是打开PPT后下拉框没有被点击过，开始抽奖的时候总会调用这个InitComboBox1()方法。原本的RefreshDic是把人员名单重新读取一遍(中过奖的人丢失了中奖标记位)，而ReadNameList只在名单为空的前提下才读取名单(中过奖的人有中奖标记位，不会重复中奖)。关于“中奖标记位”的原理，可以查看篇二中代码段P的分解。

根据实际需求，如果需要奖项互斥，把该奖项所在页上述InitComboBox1()方法中的第一行改成ReadNameList，如果需要奖项不互斥，则改成RefreshDic。但有一点需要注意——一旦在某一页抽取了不互斥的奖项，那么先前的“中奖标记位”就丢失了，也就不可能再实现后面的某几页跟前面的某几页奖项互斥了。换句话说，互斥的奖项必须连续抽取。我司的抽奖逻辑是这样的——前面的五等奖、四等奖、三等奖、二等奖以及一等奖是互斥的，这些奖项抽完之后还有一个特别的奖项，这个特别的奖项跟前述5个奖项不互斥。因此在前5个奖项的代码中都使用ReadNameList，而在最后那个特别奖项的代码中使用RefreshDic。

奖项互斥也设置完毕，最后稍微美化一下，把所有下拉框隐藏掉(因为已经选择了相应的选项)，再把不需要的“缺席”按钮也隐藏掉，至于“重置”按钮，可以按需隐藏或保留。同样需要注意的是，一旦按下“重置”按钮，“中奖标记位”也就丢失了。

最后，我们得到的抽奖PPT应该是这样的——

在上一章节中，我们已经完成了一个几乎是功能完整的抽奖PPT，所以，如果你对页面美观度要求不是很高的话，稍微修改一下背景图片(尽量选择浅色的背景以便跟白底的文本框融为一体)，基本上就可以直接拿去用作年会的抽奖程序用了(至少我司去年就是用这样一个PPT抽奖的)。但是，如果你实在不能忍受那个白底的文本框(特别是当你想用一张深色背景图片的时候)又有时间折腾一下，那么可以继续往下看。需要说明的是，用一个透明的文本框替代原本的标准文本框控件之后，虽然美观度大幅提升并且文字可以设置各种效果性能也会大幅下降(直观的感觉就是文本的滚动速度变慢了，并且文字效果越多，滚动速度越慢)。另外，不建议Office 2010以前的版本尝试本章节的内容，以下示例切换到Office 2016最新版进行。

进行下一步之前，为了调试方便，先把上一章节中隐藏掉的控件全部显示出来。通过修改控件的Visiable属性为True就可以显示被隐藏的控件。

接下来，对每一页PPT

第一步：插入两个文本框(注意不是文本控件，而是普通文本框)，并分别写上“LCDReadout”和“LogReadout”。这两个普通文本框将会替代左边的白底文本控件。

第二步：编辑该页的代码，加入下图中蓝色框出的6行代码。

1. UpdateTheLCD TextBox1.Value

2. UpdateTheLog TextBox2.Value

3. UpdateTheLCD TextBox1.Value

4. UpdateTheLCD ""

5. UpdateTheLog ""

6. UpdateTheLog TextBox2.Value

1. UpdateTheLCD TextBox1.Value

2. UpdateTheLog TextBox2.Value

3. UpdateTheLCD TextBox1.Value

4. UpdateTheLCD ""

5. UpdateTheLog ""

6. UpdateTheLog TextBox2.Value

注意一下以上两步操作是对每一页幻灯片都进行操作。然后，进入VBA窗口，双击左边的“Module1”，把下面的代码加到最后面，也就是加到代码段S的后面。

Sub NameTheShapes()

Dim objSlide As Slide

Dim objShape As Shape

For Each objSlide In ActivePresentation.Slides

For Each objShape In objSlide.Shapes

If objShape.Type = 17 Then

If objShape.TextFrame.TextRange.Text = "LCDReadout" Then

objShape.Name = "LCDReadout"

objShape.TextFrame.TextRange.Text = "Named: LCDReadout"

objSlide.Shapes("TextBox1").Visible = 0

ElseIf objShape.TextFrame.TextRange.Text = "LogReadout" Then

objShape.Name = "LogReadout"

objShape.TextFrame.TextRange.Text = "Named: LogReadout"

objSlide.Shapes("TextBox2").Visible = 0

End If

End If

Next

Next

End Sub

Sub UpdateTheLCD(str As String)

With ActivePresentation.Slides(ActivePresentation.SlideShowWindow. _

View.Slide.SlideIndex).Shapes("LCDReadout")

.TextFrame.TextRange.Text = CStr(str)

End With

End Sub

Sub UpdateTheLog(str As String)

With ActivePresentation.Slides(ActivePresentation.SlideShowWindow. _

View.Slide.SlideIndex).Shapes("LogReadout")

.TextFrame.TextRange.Text = CStr(str)

End With

End Sub

Sub NameTheShapes()

Dim objSlide As Slide

Dim objShape As Shape

For Each objSlide In ActivePresentation.Slides

For Each objShape In objSlide.Shapes

If objShape.Type = 17 Then

If objShape.TextFrame.TextRange.Text = "LCDReadout" Then

objShape.Name = "LCDReadout"

objShape.TextFrame.TextRange.Text = "Named: LCDReadout"

objSlide.Shapes("TextBox1").Visible = 0

ElseIf objShape.TextFrame.TextRange.Text = "LogReadout" Then

objShape.Name = "LogReadout"

objShape.TextFrame.TextRange.Text = "Named: LogReadout"

objSlide.Shapes("TextBox2").Visible = 0

End If

End If

Next

Next

End Sub

Sub UpdateTheLCD(str As String)

With ActivePresentation.Slides(ActivePresentation.SlideShowWindow. _

View.Slide.SlideIndex).Shapes("LCDReadout")

.TextFrame.TextRange.Text = CStr(str)

End With

End Sub

Sub UpdateTheLog(str As String)

With ActivePresentation.Slides(ActivePresentation.SlideShowWindow. _

View.Slide.SlideIndex).Shapes("LogReadout")

.TextFrame.TextRange.Text = CStr(str)

End With

End Sub

这里新增的3个方法NameTheShapes、UpdateTheLCD和UpdateTheLog，稍微解释一下。我们在每一页幻灯片上都插入了两个普通文本框(文本框的好处是没有白色底色)，然后打算用它们来代替原本的文本控件(文本控件有烦人的白色底色)。所以在每一页的代码中，原本更新文本控件内容的地方，我们加上一行代码，把文本控件的内容同步到文本框里面。这里用到了UpdateTheLCD和UpdateTheLog这两个方法，至于为什么一个叫LCDReadout一个叫LogReadout，我找到的代码示例就是这样的，懒得改了。

注意到在这两个方法中都通过相应文本框的“名称”去识别它，因此需要一个额外的方法NameTheShapes把我们新增加到每一页的两个文本框“命名”一下。这个方法通过两层嵌套的遍历，把每一页幻灯片上的每一个文本框遍历，并核对里面的文字内容，如果里面的内容正好是“LCDReadout”则把它命名为LCDReadout，同时把里面的文本改成“Named: LCDReadout”，这样方便我们观察到结果，“LogReadout”则同理。这个方法还做了一件额外的事情——把页面上原本的两个文本控件隐藏，也就是把它们的Visible属性设置成False。

接下来就是“见证奇迹”的时刻了，把PPT保存一下先。然后从“视图”菜单中选择“宏”，再选择“NameTheShapes”运行。可以看到每一页上的文本框内容都发生了变化(添加了Named: )，并且文本控件都被隐藏了。

最后再把文本框的字体调整一下，再把不需要的下拉框、“缺席”按钮、“重置”按钮等隐藏。再把“开始”按钮的背景设成黑色，得到这样一个简洁版的抽奖PPT。

如果你觉得这样把一个名字断成两行不够美观，可以再美化一下。分别找到每一页PPT的代码中这两个方法，用高亮的代码替换原来的部分。

TextBox1.Value = Replace(GetRandomString(5), ", ", vbCrLf)

TextBox1.Value = Replace(GetRandomString(5), ", ", vbCrLf)

TextBox1.Value = Replace(GetRandomString(iNum), ", ", vbCrLf)

TextBox1.Value = Replace(GetRandomString(iNum), ", ", vbCrLf)

这样，就得到了每行一个名字的滚动效果。

既然名单滚动框是文本框，可玩性就大大提高了，比如你可以给文本框分栏，分两栏、三栏，都可以。下图展示分两栏的效果。

如果还要效果再花哨一些，可以给文字加上特效，需要注意的是某些特效会显著降低性能，推荐在滚动框上使用一般的特效，而在下方静态显示的“日志”上可以使用一些炫酷的特效。

本系列原创的初衷就是很多预编译的抽奖程序你根本不知道它里面是否藏着见不得人的逻辑。抽奖嘛，当然公平最重要，虽说本例中使用的随机数不是完全的随机，但至少没有主观的作弊因素在里面。如果实在是要奖励某位或某几位功臣，直接给个什么特别奖不就行了么？

基于上述考虑，本文只会简单探讨一下“作弊”的思路，但不会把具体的代码分享出来。

通过对代码的解读，获取随机名单的关键在于GetRandomString()方法，这里提供一个最简单思路——给GetRandomString()方法传递一个可选字符串参数，比如说传递一个vbTab，告诉这个方法，必须返回名字里带Tab的人，然后，在namelist.txt里面，想要“内定”的人的名字后面多加一个Tab，然后，在需要“内定”的奖项页，调用GetRandomString()方法的时候传递Tab参数给它，而在其它不需要“内定”的奖项页，还要注意不要让“内定”的人中奖。下图演示的例子中，名字4和名字7后面是带Tab的，如果不是全选，你甚至都不会发现这两个名字是特殊的“内定”人员。

如何用抽奖PPT进行人员分组”留到下一篇吧。另外在制作我司2019年年会抽奖PPT的过程中，我还探索了一些其它的技巧和优化方法，这些都留在下一篇好了。如果关于“内定”的呼声很高的话，下一篇也可以考虑放出实现代码。最后放上一段视频，演示了我司今年将要使用的抽奖PPT。除了本篇介绍的功能以外，它还实现了“抽取一组名单之后暂停5秒”的功能(防止连续按键误触发下一次抽奖)，甚至在抽四等奖的时候还出现了前两次抽3名，后两次抽2名的情况，这些都来源于实际需求，掌握了基本原理之后，再根据实际需求进行修改就会得心应手。

查看录制的抽奖PPT视频(抽奖名单来自下文回顾的线下活动实到值友名单)。

ZDM上海剁线下聚会｜可能是史上最有腔调的分剁聚会，不服来辩小编注：想获得更多专属福利吗？金币加成、尊享众测、专属勋章、达人福利任务你想要吗？如果想要，赶紧来申请认证站内生活家！猛击此链接前言魔都分剁成立的时间并不长，但由于值友们踊跃报名、热情捧场，人数已经多到开了两个微信群才得以容下。两个群各有一位剁主管理着，线下聚会等活动也是分开进行。很荣幸被上海１群剁珑珑go|赞80评论112收藏65查看详情

希望本篇可以帮助大多数人做出一个功能完整又不失美观的抽奖PPT，2019年祝大家好运咯～