|
|
Sub 点名2()
Dim vString As String
Dim Response
Dim xlApp As Object '定义存放引用对象的变量
If Sorted = False Then
Dim txtLine
Dim FileObj
Dim TextObj
Dim FilePath
FilePath = "班.txt"
Set FileObj = CreateObject("Scripting.FileSystemObject")
Set TextObj = FileObj.OpenTextFile(FilePath)
Do While Not TextObj.AtEndOfLine
txtLine = txtLine & "," & Trim(TextObj.ReadLine)
vString = Mid(txtLine, 2)
Loop
sData = vString
vWords = Split(sData, ",")
Randomize
Dim nCount As Long
Dim nGetCnt As Long
Dim nPos As Long
Dim i As Long
Dim bExist As Boolean
Dim sWords As String
nCount = UBound(vWords)
NameCount = nCount
ReDim nWordsList(nCount) As Long
For i = 0 To nCount
nWordsList(i) = -1
Next i
Do While nGetCnt < nCount + 1
nPos = Rnd * nCount
bExist = False
For i = 0 To nCount
If nPos = nWordsList(i) Then
bExist = True
End If
Next i
If Not bExist Then
nWordsList(nGetCnt) = nPos
nGetCnt = nGetCnt + 1
End If
Loop
Sorted = True
End If
相片显示.Label1.Caption = vWords(nWordsList(CurrentNo))
相片显示.Image1.Picture = LoadPicture(相片显示.Label1.Caption & ".jpg")
相片显示.Show
If CurrentNo < NameCount Then
CurrentNo = CurrentNo + 1
Else
MsgBox "全部点到，重新点名！"
Sorted = False
CurrentNo = 0
NameCount = 0
End If
End Sub |
|
