尚有瑕疵，中奖事宜事关重大，应以此为准：
请各位路过的网友注意，以上附件均有重大瑕疵，可能造成重复，而应以此附件为依据。
原因在于用filter滤除由choose函数返回的temp数组隐含逻辑漏洞，关键在于temp数组未从大到小排序：temp作为arr数组的下标，如果先滤除的数组元素temp(0)<temp(1)，就会影响到后滤除的数组目标，因为滤后下标会前移，而choose函数得到是滤除之前的arr数组的下标。
鉴于此，已利用带key的集合**解决此问题，因为集合remove依据的不是序号，而是精准的key值；但是本层附件，仍有足以引起争议的瑕疵，因为滚动抽奖区所显示的最终抽中结果可能与右侧汇奖区显示的号码不一致（目前尚未解决，见），目前采用的策略是抽奖区只显示滚动效果，而让4次抽奖结果极速闪过，瞬飘至汇奖区。
不错，很好！！
删除集合元素代码有误，特此纠正：
Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long) '参数是长整形（毫秒数）。Lib “kernel32”标明这个函数是引用kernel32.dll提供的函数。Kernel32.dll是windows的四个核心库之一。是用来延时n毫秒的?
Dim s As New Collection, f As Boolean, j%, n%, temp '接受函数返回数组的temp不能 As String;不关闭ppt,上次的arr将一直存在,这是与在下面声明的差异
Private Sub CommandButton1_Click()
Dim i%, r%
If s.Count < 50 And j = 0 Then '不能用s.Count=0,连续调试时避免中断执行造成少于50个元素存在，一开始就无法进行j=1的初始化
TextBox2.Text = "" '清除界面的上次奖等数据
TextBox4.Text = ""
TextBox5.Visible = False
TextBox6.Visible = False
TextBox7.Visible = False
TextBox8.Visible = False
TextBox5.Text = ""
TextBox6.Text = ""
TextBox7.Text = ""
TextBox8.Text = ""
Set s = Nothing
For i = 1 To 50 '抽奖号码准备
s.Add 800 + i, CStr(800 + i)
Next
j = 1 '抽奖序次初始化
TextBox4.Text = "三等奖"
End If
f = False
If Me.CommandButton1.Caption = "停止" Then
Me.CommandButton1.Caption = "开始"
f = True
Else
Me.CommandButton1.Caption = "停止"
'MsgBox f & j '因只能在放映模式使用按钮,调试时变量监控点
n = --Mid(3321, j, 1) '抽取奖等的个数
Do
If f Then
Select Case j '操作汇奖区
Case 1
TextBox5.Text = temp(0) & " " & temp(1) & " " & temp(2)
TextBox5.Visible = True
Sleep 80 '延时让抽中号码有机会显示在抽奖区,而非一闪而过飘到汇奖区,调试改为800
TextBox1.Text = ""
TextBox2.Text = ""
TextBox3.Text = ""
Case 2
TextBox6.Text = temp(0) & " " & temp(1) & " " & temp(2)
TextBox6.Visible = True
Sleep 80
TextBox1.Text = ""
TextBox2.Text = ""
TextBox3.Text = ""
Case 3
TextBox7.Text = temp(0) & " " & temp(1)
TextBox7.Visible = True
Sleep 80
TextBox1.Text = ""
TextBox3.Text = ""
Case 4
TextBox8.Text = temp(0)
TextBox8.Visible = True
TextBox2.Text = ""
End Select
'MsgBox n & j '调试时变量监控点
j = j + 1
If j = 5 Then
MsgBox "抽奖完毕！"
j = 0
Exit Sub
Else
For i = 0 To n - 1
s.Remove (temp(i)) '滤除已抽取号码
Next
End If
TextBox4.Text = Mid("三二一特", j, 1) & "等奖" '显示待抽的下一奖等
Exit Do
Else
temp = choose(50 - Mid("0368", j, 1), n) '扣减已抽取样本数量,50-Mid("0368", j, 1)选n
For i = 0 To n - 1 '由于temp抽取的序号并未排序，s.remove时可能会造成s(--temp(i))中--temp(i)的变动和丢失，故在remove之前存好s(--temp(i)),而非存序号
temp(i) = s(--temp(i)) & "" 'choose作为字典的key已置为文本
Next
Select Case n '下框的抽奖区即时显示具体抽中号码
Case 3
TextBox1.Visible = True '因上次抽特等奖时将其隐藏
TextBox3.Visible = True
TextBox1.Text = temp(0)
TextBox2.Text = temp(1)
TextBox3.Text = temp(2)
Case 2
TextBox1.Text = temp(0)
TextBox2.Visible = False
TextBox3.Text = temp(1)
Case 1
TextBox1.Visible = False
TextBox2.Visible = True
TextBox3.Visible = False
TextBox2.Text = temp(0)
End Select
End If
Sleep 30
DoEvents
Loop
End If
End Sub
Function choose(m%, n%) '传回数组的函数不能声明为String，必须为vaiant
Dim i%, dt
Set dt = CreateObject("Scripting.Dictionary")
Randomize
Do
i = Int(Rnd * (m - 1)) + 1
dt(i & "") = "" '用字典的key来确保不重复抽取
Loop Until dt.Count = n
choose = dt.keysEnd Function
只是附件界面丑了点，终于抽时间改了：
又修改了，见完美之作。
有空琢磨一下。
大侠令人佩服，ppt接触时间之短，进步之快，令人汗颜。
有空多向你讨教。
希望不吝赐教。
太过奖了，只是一点表面功夫而已！
我一直没搞明白slide对象之间的关系，图1编辑窗口左侧显示有两页幻灯片，图2的vbe窗口则只有slide6这一个对象，那就是说图1的2#幻灯片式是slide6对象之下的，在本地窗口下的me下面也确实看不到2#幻灯片的两个shapes（其实就是插入新幻灯片时母版的的标题和下面正文文本框，模块里的录制宏可以看到分别为.Shapes("Rectangle 2")对象和.Shapes("Rectangle 3")），但就是无法用ActivePresentation.Slides(1).Shapes("Rectangle 2").TextFrame.TextRange.Text = "年终幸运榜"赋值，或slide6.Shapes("Rectangle 2").TextFrame.TextRange.Text = "年终幸运榜"，究竟该如何表示slide6第2页的shape对象？
其实我的目的，就是结束时用另一个幻灯片来替代小家子气的msgbox抽奖结果。
slide对象和ActiveWindow.Selection对象之下sliderange集合又是个什么关系？也一直没弄明白，总之ppt的对象层级关系都是稀里糊涂的！
这是两个不同的概念。
这相当于excel中有五种模块一样：标准模块、类模块、工作表模块、工作簿模块、窗体模块。
而ppt中的模块的模块也有五个：标准模块、类模块、幻灯片母板模块、幻灯片模块、窗体模块。
但excel和ppt中VBA工程窗口同中有异：
同：两者都可以通过插入命令插入标准模块、类模块、窗体模块。
异：excel中工作表模块、工作簿模块本来就存在
ppt中幻灯片母板模块、幻灯片模块在工程窗口中本来没有，也不能通过插入命令插入。
只能通过在母版或幻灯片中插入控件，再右击查看代码，就兴建了相应的模块。
混沌之下，还是焕然一新了：