如何实现人员抽点的时候抽到指定人员，而不是随机人员。
单位有个竞赛活动，然后用PPT做了个人员抽点的小程序，需要最后控制人员抽点的顺序，抽到特定的人员，但是不知道怎么实现这个效果，现求助大佬。
Dim flag As Integer '全局变量用于查询是否按下停止键
Sub delay(T As Single)
Dim time1 As Single
time1 = Timer
Do
DoEvents
Loop While Timer - time1 < T
End Sub
Private Sub 开始_Click()
flag = 0
'Dim StuData(500) As Person
'StuData() = 0
Dim StuData(500) As String
Dim buf As String
Dim i As Integer
i = 0
Open "E:\人员名册.txt" For Input As #1
'Open "E:\output.txt" For Output As #2
Do While Not EOF(1)
Line Input #1, buf
'Write #2, buf
StuData(i) = buf
i = i + 1
'在循环中将姓名输入数组
Loop
'Close #1
'Close #2
Dim index As Integer
Dim tims As Integer
times = 0
'循环显示姓名1
Do Until (times > 65534 Or flag <> 0)
index = Int((i * Rnd) + 0)
Label1.Caption = StuData(index)
times = times + 1
delay (0.05)
Loop
Close #1
End Sub
Private Sub 停止_Click()
flag = 1
End Sub
用到的代码就是以上代码
使用方法，编辑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