PPT抽奖程序
背景
公司年会,例行要搞个抽奖,去年是用抽奖箱来抽的,我觉得蛮好的,但是有人觉得不够直观,想换成用计算机来抽,虽然我觉得用机抽更不透明啦,但是有这个需要么就得去满足啊。
网上稍微找了一下,大部分不能用或者要买码注册,偶尔有几个能用的太丑了,起码我觉得蛮丑的,而且也不是很满足我们的要求。退而求其次,又看了一下用Excel来做的抽奖程序,下了几个版本的,也有上述的问题,其中大部分的VBA还加密码了,一怒之下,自己写吧。
既然准备自己写了,就按照自己的要求来了,公司这次抽奖方式是准备了从1号到300号的抽奖券,到时候数了人头给,每个进场的人自己拿一张奖券,这样上面的号码就是随机的了,奖品方面准备了30个三等奖,要求抽10次,每次抽3个数字,10个二等奖,抽5次,每次抽一个号码,还有3个一等奖和1个特等奖都是每次抽一个号码的。所以我要准备一个抽奖程序,可以输入一个数字范围,然后按照上面的要求抽出随机数字来。
一开始也准备用Excel,可是后来一想,反正都是写,用PPT的话整个界面能看起来好看一些,就用PPT来做了。
原理
有数字范围,还要抽过的不能重复,自然而然的就想到用数组来做了,构建数组很简单,不过我想给每个奖项做一个单独的页面,所以要一个全局的数组,这样得新建一个Model,然后定义一下数组,这里定义了一个1到500的,反正我这里只要用到300以内就够了
Public pool(1 To 500) As Long, IsStop As Boolean, Reduction As Integer, PCount As Integer
防止重复就没那么方便了,VBA不支持直接删除数组元素,直接.pop()这样的好事没了,网上找了找,用了个笨办法,抽到一个数字就把它后面的所有数字往前移一位,这样保证抽奖不重复
For i = 1 To PCount
If pool(i) = y Then
For j = i To PCount
pool(j) = pool(j + 1)
Next j
Exit For
End If
Next i
至于随机倒是最简单的部分,在数组的有效部分(因为每次抽签之后都要把抽到的数字给去掉)里面随机一个值就可以了。所以每次对数组现在的长度来做个随机,然后取这个位置的数字就可以了:
y = pool(Int((PCount - Reduction) * Rnd + 1))
这里用PCount来取整个数组的初始长度(也就是出席人数),每抽一次把PCount减一,这个减一操作用Reduction来完成,随机一个数字之后Reduction加一就好了。然后做个Rnd,因为Rnd是随机到[0,1)的值,所以后面加一保证覆盖的数字区域。
这样一来抽奖的主体就出来了。对于一个数字Label(例如B1),点一下抽奖键,跑一下这段代码:
y = pool(Int((PCount - Reduction) * Rnd + 1))
B1.Caption = y
For i = 1 To PCount
If pool(i) = y Then
For j = i To PCount
pool(j) = pool(j + 1)
Next j
Exit For
End If
Next i
Reduction = Reduction + 1
根据PCount-Reduction算出来的现在的数组的长度,随机出一个y值,然后在数组里面根据这个y取一个数出来显示在B1里面,之后把这个值后面所有元素往前挪一个身位保证以后的抽奖不会重复。最后把Reduction加一保证数组有效长度的正确。
这样一来,从理论上,抽奖问题就解决了,之后就是要解决一些细节上的问题了
程序细节
数字跳动
现在是点一下,数字直接跳出来,我觉得够直观,但是有人觉得没有数字在那里跳啊跳的,看起来有点假,虽然我解释了那个数字跳动就是骗人的,但是算了,还是说什么就做上去吧。
简单的加一下数字随机滚动,其实是可以在和抽奖一个按钮上完成的,但是怕按错了或者多按了少按了,还是分成两个按钮:
做了一个starting rolling的按钮,加了这些语句
Dim y As Integer, i As Integer, j As Integer, s As String
IsStop = False
For i = 1 To 5000
If IsStop = False Then
For j = 1 To 1000
B1.Caption = Int((PCount - 1 + 1) * Rnd + 1)
Next
DoEvents
End If
Next
一开始检测一下是不是需要数字滚动,然后根据PCount来随机显示一下,简单粗暴。
用i和j套两层循环,这样可以循环5000乘1000也就是500万次显示,基本上也是够了,如果循环次数不够的话,等循环次数结束以后就会报错了。
然后在抽奖那里的代码里面开头加上一句
IsStop = True
这样点抽奖,滚动就停了。
重置
这个就更简单了,只是在PPT里面要先找到Slide之后在对应那个Label来清空一下,既然要重置,这个按钮也就一并把参加人数写进数组吧:
PCount = Val(TextBox1)
For i = 1 To PCount
pool(i) = i
Next i
Label1.Caption = PCount
Reduction = 0
With Slide1
.B1.Caption = ""
.B2.Caption = ""
.B3.Caption = ""
.Label3.Caption = ""
End With
小问题
在插入控件的时候,把按钮和Label的BackStyle都设置成了0 - fmBackStyleTransparer 这样一来在编辑状态下倒是底色透明了,可是一到演示的时候,就是一个大大的白框,后来网上查了一下,在演示状态不支持控件透明底色…只好把底色乖乖的改回到背景色。

