找回密码
 立即注册
搜索

【已解决】PPT滚动随机抽取一名中奖者

1
回复
591
查看
[复制链接]

1

主题

3

帖子

8

幻币

江湖少侠

Rank: 2

积分
67
QQ
2017-12-5 08:45:18 显示全部楼层 |阅读模式
下面的代码是同时随机抽取15名中奖者的代码,也是论坛上的。
怎么改成随机抽取一人的情况啊,研究了一个早上没结果。大思路就是,按下开始键后从一个textbox的名单列表中随机提取到另一个textbox中,并且做一个循环,直到按下停止键为止。
Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
Dim arrRM, F
Private Sub CommandButton1_Click()
If Me.CommandButton1.Caption = "停" Then
Me.CommandButton1.Caption = "开始"
Call CQ_do("stop")
Else
Me.CommandButton1.Caption = "停"
Call CQ_do("start")
End If
End Sub

Private Sub CQ_do(doTag)
If doTag = "start" Then
arrRM = Split(Me.TextBox1, ";", -1, 1)

F = 0
Do While True
Sleep 30

Dim i As Integer, j As Integer, a(0 To 14) As String
Randomize
For i = 0 To 14
1:
a(i) = Int((UBound(arrRM) + 1) * Rnd)
For j = i - 1 To 0 Step -1
If a(i) = a(j) Then
GoTo 1
End If
DoEvents
Next

Next
TextBox2.Text = arrRM(a(0))
TextBox5.Text = arrRM(a(1))
TextBox6.Text = arrRM(a(2))
TextBox7.Text = arrRM(a(3))
TextBox8.Text = arrRM(a(4))
TextBox9.Text = arrRM(a(5))
TextBox10.Text = arrRM(a(6))
TextBox11.Text = arrRM(a(7))
TextBox12.Text = arrRM(a(8))
TextBox13.Text = arrRM(a(9))
TextBox14.Text = arrRM(a(10))
TextBox15.Text = arrRM(a(11))
TextBox16.Text = arrRM(a(12))
TextBox17.Text = arrRM(a(13))
TextBox18.Text = arrRM(a(14))
If F = 1 Then Exit Do
DoEvents
Loop
Else
F = 1
End If
End Sub

论坛里的代码如下:
'代码注释部分用于调试,或者你可以修改为其他用途,比如可以显示给用户观看。
Private Sub CommandButton1_Click()
If Me.CommandButton1.Caption = "停" Then
Me.CommandButton1.Caption = "开始"
Call CQ_do("stop")
Else
Me.CommandButton1.Caption = "停"
Call CQ_do("start")
End If
End Sub


Private Sub CQ_do(doTag)
Dim I
If doTag = "start" Then
arrRM = Split(Me.TextBox1, ";", -1, 1) '如果有需要你可以替换这里的空格,改为你需要的分隔符: 如个为英文分号 Split(Me.TextBox1, ";", -1, 1)
' TextBox3 = ""
' TextBox3.Visible = True
' TextBox4.Visible = True
' Me.TextBox4 = UBound(arrRM) & " " & arrRM(0) & " " & arrRM(UBound(arrRM))
F = 0
Do While True
Sleep 30
I = Int(((UBound(arrRM) + 1) * Rnd) + 0)
' TextBox3 = TextBox3 & "-" & I
TextBox2.Text = arrRM(I)
If F = 1 Then Exit Do
DoEvents
Loop
Else
F = 1
End If
End Sub
PPT学习论坛
回复

使用道具 举报

0

主题

29

帖子

69

幻币

一流武者

Rank: 3Rank: 3

积分
216
QQ
2018-1-8 09:23:33 显示全部楼层
很不错,顶一下!
PPT学习论坛
回复 支持 反对

使用道具 举报

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