PPT抽签

hzxszxd

闲来无事，再来一个PPT抽签，也算应了坛友要求
代码如下：

[Visual Basic] 纯文本查看 复制代码

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

抽签2.rar (32.41 KB, 下载次数: 209)

2025-3-3 21:04 上传

点击文件名下载附件

gaoxiaoao

感谢楼主分享

shiqiang

这个PPT抽签怎么用？

arctan1

感谢分享，请问如何增加抽取显示内容呢？

vinllar

感谢分享，之前找的抽签杀毒软件都报错。。。。。希望这个好用。。

惠夏柳

下载试用一下先

vickwu2023

这个好，感谢楼主分享。

cai2532

希望这个比较实用。

hzxszxd

shiqiang 发表于 2025-3-4 08:18
这个PPT抽签怎么用？

打开后，右边有一个文本框，抽签的内容粘贴在里面即可

shiqiang

hzxszxd 发表于 2025-3-4 12:24
打开后，右边有一个文本框，抽签的内容粘贴在里面即可

谢谢指导！