Dim usedItems As New CollectionDim allnumber, usernumber As Integer
 
Sub DrawLottery()
    On Error Resume Next
    usernumber = usedItems.Count
    allnumber = ActivePresentation.Slides("Slide2").Shapes("NameList").TextFrame.TextRange.Lines.Count
    If allnumber <= usernumber Then
        MsgBox "所有人已抽完！"
        Exit Sub
    End If
     
    Randomize
    Do
        randLine = Int(Rnd() * ActivePresentation.Slides("Slide2").Shapes("NameList").TextFrame.TextRange.Lines.Count) + 1
        currentItem = ActivePresentation.Slides("Slide2").Shapes("NameList").TextFrame.TextRange.Lines(randLine).Text
    Loop Until Not InCollection(usedItems, currentItem)
     
    usedItems.Add currentItem
    ActivePresentation.Slides("Slide2").Shapes("ResultBox").TextFrame.TextRange.Text = currentItem
End Sub
 
Function InCollection(col As Collection, ByVal val As String) As Boolean
    Dim item
    For Each item In col
        If item = val Then
            InCollection = True
            Exit Function
        End If
    Next
End Function
 
Sub ResetDraw()
    ActivePresentation.Slides("Slide2").Shapes("ResultBox").TextFrame.TextRange.Text = " "
    Set usedItems = Nothing
End Sub