vba抽奖ppt 深蓝计协电竞大赛

一、效果视图

隐藏调试框

二、使用步骤

1.操作步骤

1.设置启用宏

注意：需要启用宏才能运行改程序
首先点击文件

其次点击更多

点击选项

点击信任中心

启用宏

2.添加宏插件按钮

添加以下，也可仅添加宏
必要添加 宏【查看宏】

3.添加文本框及按钮

控件中添加文本框

添加按钮

建7个文本框。三个按钮

隐藏常量文本框，作为传参参数框
右键属性表，查看


剩余框属性如下

2.代码

点击此处查看代码


复制粘贴以下代码

代码如下（示例）：

Function T(Temp() As String, N As Integer) 'ByRef
        Dim Str1 As String
        Dim j As Integer
        '以下是数据库
        Str1 = "长安归故里,三混带三躺,你说什么都队,猪突豨勇队,白千夜,熊出没队,XYG,蒗队,J1队,娃娃鱼,TOP,打倒哥哥队,牛马队,张院土鸡队,随便打打队,WD队,ust,mn队,啊对对队,四神带一菜,爱会消失对不队,啊对对对队,Bigbug,一队混子,狗子大队,奇迹再现,秃鸡队,SFC,比奇堡队,月月鸟,回家的诱惑队,sixgod,又菜又爱玩队,YYDS,张院GOAT,GOH队,SAD,精神小伙成双队,为她夺冠"
        '命s以逗号分割为一个个数组
        s = Split(Str1, ",")
        'N为总数
        N = UBound(s) - LBound(s)
        '调试框 = 调试框 & N & "****"
        
        '等价与0到N，此代码意义为将数据库传输数组至Temp数组
        For j = 0 To UBound(s) - LBound(s)
                    Temp(j) = s(j)
        Next j
End Function

Function Printf(TempArray() As String, x)  '输出函数
        Dim i As Integer
            For i = 0 To x Step 1
                If i = x Then
                    调试框 = 调试框 & TempArray(i)
                Else
                    调试框 = 调试框 & TempArray(i) & ","
                End If
            Next i
End Function

Function D(Temp() As String, x, i)    '删除已用随机数函数，删除Temp中i到x的数组
        Dim j As Integer
                For j = i To x
                    Temp(j) = Temp(j + 1)
                Next j
        
End Function

Function T2(Temp() As String, TempArray() As String, N As Integer, y) 
'随机抽取
        Dim RndNumber, i As Integer
        Randomize (oracle)
            For i = 0 To y Step 1
                    RndNumber = Int((N + 1) * Rnd)
                    TempArray(i) = Temp(RndNumber)
                    Call D(Temp, N, RndNumber)'调用删除函数
                    N = N - 1
            Next i
            T2 = i
End Function

Private Sub 常量_Change()

End Sub

Private Sub 调试框_Change()

End Sub

Private Sub 抽取结果_Change()

End Sub

Sub 轮空_Click()
        Dim y, i As Integer
        Dim N As Integer
        Dim Temp(0 To 150) As String
        Dim TempArray(0 To 150) As String
        Call T(Temp, N)
        y = N
        i = T2(Temp, TempArray, N, y)
        Call T(Temp, N)
        If i Mod 2 = 0 Then
             'Call Printf(Temp, N)
           Call Printf(TempArray, N)
            抽取结果 = "无轮空组"
        Else
             'Call Printf(Temp, N)
            Call Printf(TempArray, N)
            抽取结果 = "轮空:" & TempArray(N) & " ; "
        End If
        常量.Text = 常量.Text + 1
        常量.Text = 0
        停止.Enabled = True
End Sub

Private Sub 清除_Click()
                抽取结果 = " "
                调试框 = " "
                左对战框 = " "
                右对战框 = " "
                左队伍框 = " "
                右队伍框 = " "
                常量 = -1
End Sub

Private Sub 停止_Click()
            Dim Str1 As String
            Dim i As String
            Dim N As Integer
            Dim a(0 To 150) As String
            Call T(a, N)
            Str1 = 调试框.Value
            s = Split(Str1, ",")
            '此处填写数据库总数，例如我的数据库中是39队因此一队轮空
            If 常量 < 39 Then
                   
                    If 常量 < 0 Then
                        调试框 = " "
                        左对战框 = " "
                        右对战框 = " "
                        左队伍框 = " "
                        右队伍框 = " "
                        常量 = -1
                    Else
                            If 常量.Text Mod 2 = 0 Then
                               左队伍框 = s(常量.Text)
                               左对战框 = s(常量.Text)
                               右队伍框 = "抽取中"
                               右对战框 = " "
                            Else
                               左队伍框 = "抽取中"
                               右队伍框 = s(常量.Text)
                               右对战框 = s(常量.Text)
                               抽取结果.Value = 抽取结果.Value & s(常量.Text - 1) & "对战" & s(常量.Text) & ";  "
                               
                            End If
                        常量.Text = 常量.Text + 1
                    End If
                    
            Else
                调试框 = " "
                左对战框 = " "
                右对战框 = " "
                左队伍框 = " "
                右队伍框 = " "
                常量 = -1
            End If
End Sub

Private Sub 右队伍框_Change()

End Sub

Private Sub 右对战框_Change()

End Sub

Private Sub 左队伍框_Change()
   
End Sub

Private Sub 左对战框_Change()

End Sub

---

复制粘贴后点击运行就行了，当然好看的背景图片还是得自己找的
资源地址：vba新手书写队伍抽签ppt