找回密码
 立即注册
搜索

PPT抽奖程序

32
回复
10027
查看
[复制链接]

3

主题

6

帖子

11

幻币

江湖少侠

Rank: 2

积分
189
QQ
2017-2-6 16:10:22 显示全部楼层 |阅读模式
大师们,请教PPT里做个抽奖程序怎么弄?801-850 50个号码
抽奖时号码滚动显示,抽中的号码不能被重复抽奖
抽奖---.zip (84.58 KB, 下载次数: 68)

本帖被以下精选资料库推荐:

PPT学习论坛
回复

使用道具 举报

2

主题

8

帖子

56

幻币

一流武者

Rank: 3Rank: 3

积分
277
QQ
2017-2-6 18:49:50 显示全部楼层
请各位路过的网友注意,以上附件均有重大瑕疵,可能造成重复,而应以此附件为依据。
原因在于用filter滤除由choose函数返回的temp数组隐含逻辑漏洞,关键在于temp数组未从大到小排序:temp作为arr数组的下标,如果先滤除的数组元素temp(0)<temp(1),就会影响到后滤除的数组目标,因为滤后下标会前移,而choose函数得到是滤除之前的arr数组的下标。
鉴于此,已利用带key的集合**解决此问题,因为集合remove依据的不是序号,而是精准的key值;但是本层附件,仍有足以引起争议的瑕疵,因为滚动抽奖区所显示的最终抽中结果可能与右侧汇奖区显示的号码不一致(目前尚未解决,见),目前采用的策略是抽奖区只显示滚动效果,而让4次抽奖结果极速闪过,瞬飘至汇奖区。
依次逐等抽奖并集中抽奖结果----h.rar (55 KB, 下载次数: 75)
PPT学习论坛
回复 支持 2 反对 0

使用道具 举报

3

主题

10

帖子

10

幻币

江湖少侠

Rank: 2

积分
163
QQ
2017-2-6 17:33:33 显示全部楼层
大侠们,请赐教!
PPT学习论坛
回复 支持 反对

使用道具 举报

2

主题

6

帖子

57

幻币

江湖少侠

Rank: 2

积分
183
QQ
2017-2-6 17:38:50 显示全部楼层
请高手赐教
PPT学习论坛
回复 支持 反对

使用道具 举报

1

主题

4

帖子

82

幻币

一流武者

Rank: 3Rank: 3

积分
348
QQ
2017-2-6 17:41:08 显示全部楼层
PPT里嵌入VBA做这个抽奖程序怎么弄啊?高手
PPT学习论坛
回复 支持 反对

使用道具 举报

3

主题

8

帖子

64

幻币

一流武者

Rank: 3Rank: 3

积分
238
QQ
2017-2-6 17:46:05 显示全部楼层
沉了吗?自己顶一下,期待高手指点
PPT学习论坛
回复 支持 反对

使用道具 举报

4

主题

6

帖子

56

幻币

一流武者

Rank: 3Rank: 3

积分
226
QQ
2017-2-6 17:51:33 显示全部楼层
期待高手赐教
PPT学习论坛
回复 支持 反对

使用道具 举报

2

主题

4

帖子

69

幻币

一流武者

Rank: 3Rank: 3

积分
289
QQ
2017-2-6 17:53:03 显示全部楼层
在最后slide
用放映模式方可抽奖

  • Private Declare Sub Sleep Lib &quot;kernel32&quot; (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 = &quot;&quot;
  •    TextBox4.Text = &quot;&quot;
  •    TextBox5.Text = &quot;&quot;
  •    TextBox6.Text = &quot;&quot;
  •    TextBox7.Text = &quot;&quot;
  •    TextBox8.Text = &quot;&quot;
  •    ReDim arr(1 To 50)
  •    For i = 1 To 50
  •        arr(i) = 800 + i
  •    Next
  •    j = 1
  •    TextBox4.Text = &quot;三等奖&quot;
  • End If
  • If Me.CommandButton1.Caption = &quot;停止&quot; Then
  •    Me.CommandButton1.Caption = &quot;开始&quot;
  •    f = True
  •    'MsgBox f & j                             '因只能在放映模式使用按钮,调试设置变量监控点
  •    Select Case j
  •           Case 1
  •               TextBox5.Text = arr(temp(0)) & &quot; &quot; & arr(temp(1)) & &quot; &quot; & arr(temp(2))
  •               TextBox1.Text = &quot;&quot;
  •               TextBox2.Text = &quot;&quot;
  •               TextBox3.Text = &quot;&quot;
  •           Case 2
  •               TextBox6.Text = arr(temp(0)) & &quot; &quot; & arr(temp(1)) & &quot; &quot; & arr(temp(2))
  •               TextBox1.Text = &quot;&quot;
  •               TextBox2.Text = &quot;&quot;
  •               TextBox3.Text = &quot;&quot;
  •           Case 3
  •               TextBox7.Text = arr(temp(0)) & &quot; &quot; & arr(temp(1))
  •               TextBox1.Text = &quot;&quot;
  •               TextBox3.Text = &quot;&quot;
  •           Case 4
  •               TextBox8.Text = arr(temp(0))
  •               TextBox2.Text = &quot;&quot;
  •    End Select
  •    'MsgBox n & j                              '变量监控点
  •    For i = 0 To n - 1
  •        arr = Filter(arr, arr(temp(i)), False) '滤除已抽取号码
  •    Next
  •    If j = 4 Then
  •       MsgBox &quot;抽奖完毕!&quot;
  •       Exit Sub
  •    End If
  •    j = j + 1
  •    TextBox4.Text = Mid(&quot;三二一特&quot;, j, 1) & &quot;等奖&quot;
  • Else
  •    Me.CommandButton1.Caption = &quot;停止&quot;
  •    f = False
  •    'MsgBox f & j                             '变量监控点
  •    n = --Mid(3321, j, 1)                     '抽取奖等个数
  •    r = Mid(&quot;0368&quot;, 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(&quot;Scripting.Dictionary&quot;)
  • Randomize
  • Do
  •    i = Int(Rnd * (m - 1)) + 1
  •    dt(i & &quot;&quot;) = &quot;&quot;                  '用字典的key来确保不重复抽取
  • Loop Until dt.Count = n
  • choose = dt.keysEnd Function

复制代码
PPT学习论坛
回复 支持 反对

使用道具 举报

1

主题

4

帖子

79

幻币

一流武者

Rank: 3Rank: 3

积分
228
2017-2-6 17:55:49 显示全部楼层
再次优化代码:

  • Private Declare Sub Sleep Lib &quot;kernel32&quot; (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 = &quot;&quot;                        '清除界面的上次奖等数据
  •    TextBox4.Text = &quot;&quot;
  •    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 = &quot;三等奖&quot;
  • End If
  • If Me.CommandButton1.Caption = &quot;停止&quot; Then
  •    Me.CommandButton1.Caption = &quot;开始&quot;
  •    f = True
  •    'MsgBox f & j                             '因只能在放映模式使用按钮,调试设置变量监控点
  •    Select Case j                             '汇集抽奖结果
  •           Case 1
  •               TextBox5.Text = arr(temp(0)) & &quot; &quot; & arr(temp(1)) & &quot; &quot; & arr(temp(2))
  •               TextBox5.Visible = True
  •               TextBox1.Text = &quot;&quot;
  •               TextBox2.Text = &quot;&quot;
  •               TextBox3.Text = &quot;&quot;
  •           Case 2
  •               TextBox6.Text = arr(temp(0)) & &quot; &quot; & arr(temp(1)) & &quot; &quot; & arr(temp(2))
  •               TextBox6.Visible = True
  •               TextBox1.Text = &quot;&quot;
  •               TextBox2.Text = &quot;&quot;
  •               TextBox3.Text = &quot;&quot;
  •           Case 3
  •               TextBox7.Text = arr(temp(0)) & &quot; &quot; & arr(temp(1))
  •               TextBox7.Visible = True
  •               TextBox1.Text = &quot;&quot;
  •               TextBox3.Text = &quot;&quot;
  •           Case 4
  •               TextBox8.Text = arr(temp(0))
  •               TextBox8.Visible = True
  •    End Select
  •    'MsgBox n & j                              '变量监控点
  •    j = j + 1
  •    If j = 5 Then
  •       MsgBox &quot;抽奖完毕!&quot;
  •       Exit Sub
  •    End If
  •    For i = 0 To n - 1
  •        arr = Filter(arr, arr(temp(i)), False) '滤除已抽取号码
  •    Next
  •    TextBox4.Text = Mid(&quot;三二一特&quot;, j, 1) & &quot;等奖&quot; '显示待抽的下一奖等
  • Else
  •    Me.CommandButton1.Caption = &quot;停止&quot;
  •    f = False
  •    'MsgBox f & j                             '变量监控点
  •    n = --Mid(3321, j, 1)                     '抽取奖等的个数
  •    r = Mid(&quot;0368&quot;, 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(&quot;Scripting.Dictionary&quot;)
  • Randomize
  • Do
  •    i = Int(Rnd * (m - 1)) + 1
  •    dt(i & &quot;&quot;) = &quot;&quot;                  '用字典的key来确保不重复抽取
  • Loop Until dt.Count = n
  • choose = dt.keys
  • End Function

复制代码
PPT学习论坛
回复 支持 反对

使用道具 举报

2

主题

6

帖子

43

幻币

江湖少侠

Rank: 2

积分
148
2017-2-6 17:58:26 显示全部楼层
因发帖无反馈造成重复发帖,请删除!
PPT学习论坛
回复 支持 反对

使用道具 举报

1

主题

12

帖子

63

幻币

江湖少侠

Rank: 2

积分
186
QQ
2017-2-6 18:00:39 显示全部楼层
在最后slide,需要在放映模式抽奖
这个用在32位操作系统中: 抽奖-h.rar (68.28 KB, 下载次数: 182)
PPT学习论坛
回复 支持 反对

使用道具 举报

您需要登录后才可以回帖 登录 | 立即注册