需要一个人员抽点的程序，显示的界面能够看到出场的顺序，以及能够控制出场的人员，抽点到指定的人员。
需要一个人员抽点的程序，能够实现抽点到的人员是可控制的，想抽到谁就可以抽到谁。
使用方法，编辑names文件，每个名字1行
注意，需要抽取的人，名字后面加上一个空格
不希望抽取的人，不要加
则程序滚动的时候，所有人都参与滚动，停止的时候，有空格的才会出来
Option Explicit
Private isRunning As Boolean
Dim names() As String
Private Sub CommandButton1_Click()
CommandButton1.Enabled = False
Dim filecontent As String
Open "names.txt" For Binary As #1
filecontent = Input(LOF(1), #1)
Close #1
names = Split(filecontent, vbCrLf)
Randomize
isRunning = True
While isRunning
TextBox1.Text = RndName(False)
DoEvents
Wend
TextBox1.Text = RndName(True)
If TextBox1.Text = "" Then CommandButton1.Enabled = True: Exit Sub
If Me.Application.ActivePresentation.Slides(2).Shapes(6).TextFrame.TextRange.Text <> "" Then Me.Application.ActivePresentation.Slides(2).Shapes(6).TextFrame.TextRange.Text = Me.Application.ActivePresentation.Slides(2).Shapes(6).TextFrame.TextRange.Text & ","
Me.Application.ActivePresentation.Slides(2).Shapes(6).TextFrame.TextRange.Text = Me.Application.ActivePresentation.Slides(2).Shapes(6).TextFrame.TextRange.Text & TextBox1.Text
CommandButton1.Enabled = True
End Sub
Private Function RndName(isSpec As Boolean) As String
Dim cnt As Long
cnt = 1
Dim idx As Long
Do
cnt = cnt + 1
If cnt > 99999 Then
RndName = ""
Exit Function
End If
idx = Int(Rnd * (UBound(names) - LBound(names) + 1)) + LBound(names)
If Not IsExist(names(idx)) Then
If isSpec Then
If (names(idx) <> Trim(names(idx))) Then
RndName = Trim(names(idx))
Exit Do
End If
Else
RndName = Trim(names(idx))
Exit Do
End If
End If
Loop
End Function
Private Function IsExist(name As String) As Boolean
Dim arr() As String
arr = Split(Me.Application.ActivePresentation.Slides(2).Shapes(6).TextFrame.TextRange.Text, ",")
Dim i As Long
For i = LBound(arr) To UBound(arr)
If Trim(name) = Trim(arr(i)) Then
IsExist = True
Exit Function
End If
Next
IsExist = False
End Function
Private Sub CommandButton2_Click()
isRunning = False
End Sub