excel学习库

基于Excel VBA设计的抽奖系统，演示GIF如下所示。

主要功能

1.滚屏显示抽奖；

2.可以自定义奖项设置及人数；

3.如果当前抽取的奖项已满，设置弹出提醒。

设计思路

这里主要利用ActiveX控件---ToggleButton切换按钮。当我们点击切换按钮，ToggleButton的Value属性为True；再次点击切换按钮，ToggleButton的Value属性为False，从而实现切换按钮的状态。

当我们按下按钮时，滚屏显示，同时修改按钮名称为“暂停抽奖”；再次按下按钮，则暂停滚屏显示，并将[抽奖序号、姓名、奖项]写入中奖名单之中。

核心代码

Private Sub ToggleButton1_Click()
    Range("C2:C4").Select
    Selection.Find(What:=Range("F2").Value).Activate
    '当前奖项设置的人数
    num = ActiveCell.Offset(0, 1).Value
    '中奖名单的最后行号
    lastRow = Range("K" & Rows.Count).End(xlUp).Row
    '当前奖项已抽几个人？
    pCount = WorksheetFunction.CountIf(Range("k9:k" & lastRow), Range("F2").Value)
    If ToggleButton1.Value = True Then
        If pCount >= num Then
            MsgBox (Range("F2").Value & "的中奖人数已满")
            ToggleButton1.Value = False
            Exit Sub
        End If
        ToggleButton1.Caption = "结束抽奖"
        Do While ToggleButton1.Value = True
            rcount = Range("A2").End(xlDown).Row
            randx = WorksheetFunction.RandBetween(2, rcount)
            Range("I1") = Range("A2:A" & rcount).Cells(randx, 1)
            DoEvents
        Loop
    Else
        If pCount >= num Then
            Exit Sub
        End If
        Dim c As Range
        Set c = Range("I" & Rows.Count).End(xlUp).Offset(1, 0)
        c.Value = Cells(Rows.Count, 9).End(xlUp).Row - 8
        c.Offset(0, 1) = Range("I1")
        c.Offset(0, 2) = Range("F2")
        i = i + 1
        ToggleButton1.Caption = "开始抽奖"
    End If
End Sub