PPT抽奖程序
大师们，请教PPT里做个抽奖程序怎么弄？801-850 50个号码抽奖时号码滚动显示，抽中的号码不能被重复抽奖
请各位路过的网友注意，以上附件均有重大瑕疵，可能造成重复，而应以此附件为依据。
原因在于用filter滤除由choose函数返回的temp数组隐含逻辑漏洞，关键在于temp数组未从大到小排序：temp作为arr数组的下标，如果先滤除的数组元素temp(0)<temp(1)，就会影响到后滤除的数组目标，因为滤后下标会前移，而choose函数得到是滤除之前的arr数组的下标。
鉴于此，已利用带key的集合**解决此问题，因为集合remove依据的不是序号，而是精准的key值；但是本层附件，仍有足以引起争议的瑕疵，因为滚动抽奖区所显示的最终抽中结果可能与右侧汇奖区显示的号码不一致（目前尚未解决，见），目前采用的策略是抽奖区只显示滚动效果，而让4次抽奖结果极速闪过，瞬飘至汇奖区。
大侠们，请赐教！ 请高手赐教 PPT里嵌入VBA做这个抽奖程序怎么弄啊?高手 沉了吗？自己顶一下，期待高手指点 期待高手赐教 在最后slide
用放映模式方可抽奖
[*]Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long) '参数是长整形（毫秒数）。Lib “kernel32”标明这个函数是引用kernel32.dll提供的函数。Kernel32.dll是windows的四个核心库之一。是用来延时n毫秒的?
[*]Dim arr, f As Boolean, j%, n%, temp '接受函数返回数组的temp不能 As String
[*]Private Sub CommandButton1_Click()
[*]Dim i%, r%
[*]If IsEmpty(arr) Then
[*] TextBox1.Visible = True
[*] TextBox3.Visible = True
[*] TextBox2.Text = ""
[*] TextBox4.Text = ""
[*] TextBox5.Text = ""
[*] TextBox6.Text = ""
[*] TextBox7.Text = ""
[*] TextBox8.Text = ""
[*] ReDim arr(1 To 50)
[*] For i = 1 To 50
[*] arr(i) = 800 + i
[*] Next
[*] j = 1
[*] TextBox4.Text = "三等奖"
[*]End If
[*]If Me.CommandButton1.Caption = "停止" Then
[*] Me.CommandButton1.Caption = "开始"
[*] f = True
[*] 'MsgBox f & j '因只能在放映模式使用按钮,调试设置变量监控点
[*] Select Case j
[*] Case 1
[*] TextBox5.Text = arr(temp(0)) & " " & arr(temp(1)) & " " & arr(temp(2))
[*] TextBox1.Text = ""
[*] TextBox2.Text = ""
[*] TextBox3.Text = ""
[*] Case 2
[*] TextBox6.Text = arr(temp(0)) & " " & arr(temp(1)) & " " & arr(temp(2))
[*] TextBox1.Text = ""
[*] TextBox2.Text = ""
[*] TextBox3.Text = ""
[*] Case 3
[*] TextBox7.Text = arr(temp(0)) & " " & arr(temp(1))
[*] TextBox1.Text = ""
[*] TextBox3.Text = ""
[*] Case 4
[*] TextBox8.Text = arr(temp(0))
[*] TextBox2.Text = ""
[*] End Select
[*] 'MsgBox n & j '变量监控点
[*] For i = 0 To n - 1
[*] arr = Filter(arr, arr(temp(i)), False) '滤除已抽取号码
[*] Next
[*] If j = 4 Then
[*] MsgBox "抽奖完毕！"
[*] Exit Sub
[*] End If
[*] j = j + 1
[*] TextBox4.Text = Mid("三二一特", j, 1) & "等奖"
[*]Else
[*] Me.CommandButton1.Caption = "停止"
[*] f = False
[*] 'MsgBox f & j '变量监控点
[*] n = --Mid(3321, j, 1) '抽取奖等个数
[*] r = Mid("0368", j, 1) '抽剩应扣减样本数量
[*] 'MsgBox r '变量监控点
[*] Do
[*] Sleep 10
[*] If f Then Exit Do
[*] temp = choose(50 - r, n)
[*] Select Case n
[*] Case 3
[*] TextBox1.Visible = True
[*] TextBox2.Visible = True
[*] TextBox3.Visible = True
[*] TextBox1.Text = arr(temp(0))
[*] TextBox2.Text = arr(temp(1))
[*] TextBox3.Text = arr(temp(2))
[*] Case 2
[*] TextBox1.Text = arr(temp(0))
[*] TextBox2.Visible = False
[*] TextBox3.Text = arr(temp(1))
[*] Case 1
[*] TextBox1.Visible = False
[*] TextBox2.Visible = True
[*] TextBox3.Visible = False
[*] TextBox2.Text = arr(temp(0))
[*] End Select
[*] 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
复制代码 再次优化代码：
[*]Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long) '参数是长整形（毫秒数）。Lib “kernel32”标明这个函数是引用kernel32.dll提供的函数。Kernel32.dll是windows的四个核心库之一。是用来延时n毫秒的?
[*]Dim arr, f As Boolean, j%, n%, temp '接受函数返回数组的temp不能 As String
[*]Private Sub CommandButton1_Click()
[*]Dim i%, r%
[*]If IsEmpty(arr) Then
[*] TextBox1.Visible = True '因上次抽特等奖时将其隐藏
[*] TextBox3.Visible = True
[*] TextBox2.Text = "" '清除界面的上次奖等数据
[*] TextBox4.Text = ""
[*] TextBox5.Visible = False
[*] TextBox6.Visible = False
[*] TextBox7.Visible = False
[*] TextBox8.Visible = False
[*] ReDim arr(1 To 50)
[*] For i = 1 To 50 '抽奖号码准备
[*] arr(i) = 800 + i
[*] Next
[*] j = 1 '抽奖序次初始化
[*] TextBox4.Text = "三等奖"
[*]End If
[*]If Me.CommandButton1.Caption = "停止" Then
[*] Me.CommandButton1.Caption = "开始"
[*] f = True
[*] 'MsgBox f & j '因只能在放映模式使用按钮,调试设置变量监控点
[*] Select Case j '汇集抽奖结果
[*] Case 1
[*] TextBox5.Text = arr(temp(0)) & " " & arr(temp(1)) & " " & arr(temp(2))
[*] TextBox5.Visible = True
[*] TextBox1.Text = ""
[*] TextBox2.Text = ""
[*] TextBox3.Text = ""
[*] Case 2
[*] TextBox6.Text = arr(temp(0)) & " " & arr(temp(1)) & " " & arr(temp(2))
[*] TextBox6.Visible = True
[*] TextBox1.Text = ""
[*] TextBox2.Text = ""
[*] TextBox3.Text = ""
[*] Case 3
[*] TextBox7.Text = arr(temp(0)) & " " & arr(temp(1))
[*] TextBox7.Visible = True
[*] TextBox1.Text = ""
[*] TextBox3.Text = ""
[*] Case 4
[*] TextBox8.Text = arr(temp(0))
[*] TextBox8.Visible = True
[*] End Select
[*] 'MsgBox n & j '变量监控点
[*] j = j + 1
[*] If j = 5 Then
[*] MsgBox "抽奖完毕！"
[*] Exit Sub
[*] End If
[*] For i = 0 To n - 1
[*] arr = Filter(arr, arr(temp(i)), False) '滤除已抽取号码
[*] Next
[*] TextBox4.Text = Mid("三二一特", j, 1) & "等奖" '显示待抽的下一奖等
[*]Else
[*] Me.CommandButton1.Caption = "停止"
[*] f = False
[*] 'MsgBox f & j '变量监控点
[*] n = --Mid(3321, j, 1) '抽取奖等的个数
[*] r = Mid("0368", j, 1) '抽剩应扣减样本数量
[*] 'MsgBox r '变量监控点
[*] Do
[*] Sleep 10
[*] If f Then Exit Do
[*] temp = choose(50 - r, n) '50-r选n
[*] Select Case n '下框显示具体抽中号码
[*] Case 3
[*] TextBox1.Visible = True
[*] TextBox2.Visible = True
[*] TextBox3.Visible = True
[*] TextBox1.Text = arr(temp(0))
[*] TextBox2.Text = arr(temp(1))
[*] TextBox3.Text = arr(temp(2))
[*] Case 2
[*] TextBox1.Text = arr(temp(0))
[*] TextBox2.Visible = False
[*] TextBox3.Text = arr(temp(1))
[*] Case 1
[*] TextBox1.Visible = False
[*] TextBox2.Visible = True
[*] TextBox3.Visible = False
[*] TextBox2.Text = arr(temp(0))
[*] End Select
[*] 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.keys
[*]End Function
复制代码 因发帖无反馈造成重复发帖，请删除！ 在最后slide，需要在放映模式抽奖
这个用在32位操作系统中：
下面这个用在64位操作系统中：