PPT抽奖程序

ccyan3

大师们，请教PPT里做个抽奖程序怎么弄？801-850   50个号码
抽奖时号码滚动显示，抽中的号码不能被重复抽奖
抽奖---.zip (84.58 KB, 下载次数: 779)

2016-9-14 13:35 上传

点击文件名下载附件

ccyan3

大侠们，请赐教！

ccyan3

请高手赐教

ccyan3

PPT里嵌入VBA做这个抽奖程序怎么弄啊?高手

ccyan3

沉了吗？自己顶一下，期待高手指点

ccyan3

期待高手赐教

hhjjpp

ccyan3 发表于 2016-9-22 08:56
期待高手赐教

在最后slide
用放映模式方可抽奖

1. Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long) '参数是长整形（毫秒数）。Lib “kernel32”标明这个函数是引用kernel32.dll提供的函数。Kernel32.dll是windows的四个核心库之一。是用来延时n毫秒的?
   
2. Dim arr, f As Boolean, j%, n%, temp                                     '接受函数返回数组的temp不能 As String
   
3. Private Sub CommandButton1_Click()
   
4. Dim i%, r%
   
5. If IsEmpty(arr) Then
   
6.    TextBox1.Visible = True
   
7.    TextBox3.Visible = True
   
8.    TextBox2.Text = ""
   
9.    TextBox4.Text = ""
   
10.    TextBox5.Text = ""
    
11.    TextBox6.Text = ""
    
12.    TextBox7.Text = ""
    
13.    TextBox8.Text = ""
    
14.    ReDim arr(1 To 50)
    
15.    For i = 1 To 50
    
16.        arr(i) = 800 + i
    
17.    Next
    
18.    j = 1
    
19.    TextBox4.Text = "三等奖"
    
20. End If
    
21. If Me.CommandButton1.Caption = "停止" Then
    
22.    Me.CommandButton1.Caption = "开始"
    
23.    f = True
    
24.    'MsgBox f & j                             '因只能在放映模式使用按钮,调试设置变量监控点
    
25.    Select Case j
    
26.           Case 1
    
27.               TextBox5.Text = arr(temp(0)) & " " & arr(temp(1)) & " " & arr(temp(2))
    
28.               TextBox1.Text = ""
    
29.               TextBox2.Text = ""
    
30.               TextBox3.Text = ""
    
31.           Case 2
    
32.               TextBox6.Text = arr(temp(0)) & " " & arr(temp(1)) & " " & arr(temp(2))
    
33.               TextBox1.Text = ""
    
34.               TextBox2.Text = ""
    
35.               TextBox3.Text = ""
    
36.           Case 3
    
37.               TextBox7.Text = arr(temp(0)) & " " & arr(temp(1))
    
38.               TextBox1.Text = ""
    
39.               TextBox3.Text = ""
    
40.           Case 4
    
41.               TextBox8.Text = arr(temp(0))
    
42.               TextBox2.Text = ""
    
43.    End Select
    
44.    'MsgBox n & j                              '变量监控点
    
45.    For i = 0 To n - 1
    
46.        arr = Filter(arr, arr(temp(i)), False) '滤除已抽取号码
    
47.    Next
    
48.    If j = 4 Then
    
49.       MsgBox "抽奖完毕！"
    
50.       Exit Sub
    
51.    End If
    
52.    j = j + 1
    
53.    TextBox4.Text = Mid("三二一特", j, 1) & "等奖"
    
54. Else
    
55.    Me.CommandButton1.Caption = "停止"
    
56.    f = False
    
57.    'MsgBox f & j                             '变量监控点
    
58.    n = --Mid(3321, j, 1)                     '抽取奖等个数
    
59.    r = Mid("0368", j, 1)                     '抽剩应扣减样本数量
    
60.    'MsgBox r                                 '变量监控点
    
61.    Do
    
62.       Sleep 10
    
63.       If f Then Exit Do
    
64.       temp = choose(50 - r, n)
    
65.       Select Case n
    
66.              Case 3
    
67.                   TextBox1.Visible = True
    
68.                   TextBox2.Visible = True
    
69.                   TextBox3.Visible = True
    
70.                   TextBox1.Text = arr(temp(0))
    
71.                   TextBox2.Text = arr(temp(1))
    
72.                   TextBox3.Text = arr(temp(2))
    
73.              Case 2
    
74.                   TextBox1.Text = arr(temp(0))
    
75.                   TextBox2.Visible = False
    
76.                   TextBox3.Text = arr(temp(1))
    
77.              Case 1
    
78.                   TextBox1.Visible = False
    
79.                   TextBox2.Visible = True
    
80.                   TextBox3.Visible = False
    
81.                   TextBox2.Text = arr(temp(0))
    
82.       End Select
    
83.       DoEvents
    
84.    Loop
    
85. End If
    
86. End Sub
    
87. Function choose(m%, n%)             '传回数组的函数不能声明为String，必须为vaiant
    
88. Dim i%, dt
    
89. Set dt = CreateObject("Scripting.Dictionary")
    
90. Randomize
    
91. Do
    
92.    i = Int(Rnd * (m - 1)) + 1
    
93.    dt(i & "") = ""                  '用字典的key来确保不重复抽取
    
94. Loop Until dt.Count = n
    
95. choose = dt.keys
    
96. End Function

复制代码

hhjjpp

再次优化代码：

1. Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long) '参数是长整形（毫秒数）。Lib “kernel32”标明这个函数是引用kernel32.dll提供的函数。Kernel32.dll是windows的四个核心库之一。是用来延时n毫秒的?
   
2. Dim arr, f As Boolean, j%, n%, temp                                     '接受函数返回数组的temp不能 As String
   
3. Private Sub CommandButton1_Click()
   
4. Dim i%, r%
   
5. If IsEmpty(arr) Then
   
6.    TextBox1.Visible = True                   '因上次抽特等奖时将其隐藏
   
7.    TextBox3.Visible = True
   
8.    TextBox2.Text = ""                        '清除界面的上次奖等数据
   
9.    TextBox4.Text = ""
   
10.    TextBox5.Visible = False
    
11.    TextBox6.Visible = False
    
12.    TextBox7.Visible = False
    
13.    TextBox8.Visible = False
    
14.    ReDim arr(1 To 50)
    
15.    For i = 1 To 50                           '抽奖号码准备
    
16.        arr(i) = 800 + i
    
17.    Next
    
18.    j = 1                                     '抽奖序次初始化
    
19.    TextBox4.Text = "三等奖"
    
20. End If
    
21. If Me.CommandButton1.Caption = "停止" Then
    
22.    Me.CommandButton1.Caption = "开始"
    
23.    f = True
    
24.    'MsgBox f & j                             '因只能在放映模式使用按钮,调试设置变量监控点
    
25.    Select Case j                             '汇集抽奖结果
    
26.           Case 1
    
27.               TextBox5.Text = arr(temp(0)) & " " & arr(temp(1)) & " " & arr(temp(2))
    
28.               TextBox5.Visible = True
    
29.               TextBox1.Text = ""
    
30.               TextBox2.Text = ""
    
31.               TextBox3.Text = ""
    
32.           Case 2
    
33.               TextBox6.Text = arr(temp(0)) & " " & arr(temp(1)) & " " & arr(temp(2))
    
34.               TextBox6.Visible = True
    
35.               TextBox1.Text = ""
    
36.               TextBox2.Text = ""
    
37.               TextBox3.Text = ""
    
38.           Case 3
    
39.               TextBox7.Text = arr(temp(0)) & " " & arr(temp(1))
    
40.               TextBox7.Visible = True
    
41.               TextBox1.Text = ""
    
42.               TextBox3.Text = ""
    
43.           Case 4
    
44.               TextBox8.Text = arr(temp(0))
    
45.               TextBox8.Visible = True
    
46.    End Select
    
47.    'MsgBox n & j                              '变量监控点
    
48.    j = j + 1
    
49.    If j = 5 Then
    
50.       MsgBox "抽奖完毕！"
    
51.       Exit Sub
    
52.    End If
    
53.    For i = 0 To n - 1
    
54.        arr = Filter(arr, arr(temp(i)), False) '滤除已抽取号码
    
55.    Next
    
56.    TextBox4.Text = Mid("三二一特", j, 1) & "等奖" '显示待抽的下一奖等
    
57. Else
    
58.    Me.CommandButton1.Caption = "停止"
    
59.    f = False
    
60.    'MsgBox f & j                             '变量监控点
    
61.    n = --Mid(3321, j, 1)                     '抽取奖等的个数
    
62.    r = Mid("0368", j, 1)                     '抽剩应扣减样本数量
    
63.    'MsgBox r                                 '变量监控点
    
64.    Do
    
65.       Sleep 10
    
66.       If f Then Exit Do
    
67.       temp = choose(50 - r, n)               '50-r选n
    
68.       Select Case n                          '下框显示具体抽中号码
    
69.              Case 3
    
70.                   TextBox1.Visible = True
    
71.                   TextBox2.Visible = True
    
72.                   TextBox3.Visible = True
    
73.                   TextBox1.Text = arr(temp(0))
    
74.                   TextBox2.Text = arr(temp(1))
    
75.                   TextBox3.Text = arr(temp(2))
    
76.              Case 2
    
77.                   TextBox1.Text = arr(temp(0))
    
78.                   TextBox2.Visible = False
    
79.                   TextBox3.Text = arr(temp(1))
    
80.              Case 1
    
81.                   TextBox1.Visible = False
    
82.                   TextBox2.Visible = True
    
83.                   TextBox3.Visible = False
    
84.                   TextBox2.Text = arr(temp(0))
    
85.       End Select
    
86.       DoEvents
    
87.    Loop
    
88. End If
    
89. End Sub
    
90. Function choose(m%, n%)             '传回数组的函数不能声明为String，必须为vaiant
    
91. Dim i%, dt
    
92. Set dt = CreateObject("Scripting.Dictionary")
    
93. Randomize
    
94. Do
    
95.    i = Int(Rnd * (m - 1)) + 1
    
96.    dt(i & "") = ""                  '用字典的key来确保不重复抽取
    
97. Loop Until dt.Count = n
    
98. choose = dt.keys
    
99. End Function
    

复制代码

hhjjpp

因发帖无反馈造成重复发帖，请删除！

hhjjpp

在最后slide，需要在放映模式抽奖