暂无图片
暂无图片
暂无图片
暂无图片
暂无图片
首页 / 利用VBA制作一个转盘游戏之三：转盘转动

利用VBA制作一个转盘游戏之三：转盘转动

VBA语言専攻 2023-05-28
88
【分享成果，随喜正能量】人生的重启方式，在于信心的强大，勇敢一些，快乐一些，增加信心，升华情怀。那些暂时化解不了的生命困顿，便用情怀的超越去转化它。。
《VBA高级应用30例》（10178985），是我推出的第十套教程，教程是专门针对高级学员在学习VBA过程中提高路途上的案例展开，这套教程案例与理论结合，紧贴“实战”，并做“战术总结”，以便大家能很好的应用。教程的目的是要求大家在实际工作中分发VBA程序，写好的程序可以升级。本套教程共三册三十个专题，今日内容是第5   个专题“利用VBA制作一个转盘游戏”，今日讲解：利用VBA制作一个转盘游戏之三：转盘转动          
           

应用5  利用VBA制作一个转盘游戏  

在实际工作中，我们发现Excel是一个非常严肃和强大的应用程序，但这并不意味着我们不能从中得到乐趣。在本文中，我将给大家讲解如何构建一个Excel文件，使您能够玩幸运轮，同时我们会辅助声音和一些必要游戏基础设施构建！

4  转盘游戏代码实现之转盘转动  

初始化后，我们要让转盘转动了，看下面的代码：
Sub mynzSpinIt()
    Dim lCT As Long
    Dim lCt2 As Long
    Dim lCount As Long
    Dim bOK As Boolean
    '设置参与的数值数量
    lCount = Worksheets("Sheet1").Range("B1").Value
    With Worksheets("Sheet1")
        Do While bOK = False
            i = 4
            Do While .Cells(i, 1) <> ""
                .Cells(i, 2) = WorksheetFunction.RandBetween(1, lCount * 10)
                i = i + 1
            Loop
            '序号排序，人员序号从开始的顺序打乱一下
            .Range("A3:B" & lCount + 3).Sort Key1:=.Range("A3"), _
                Order1:=xlAscending, Header:=xlYes, _
                OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
                DataOption1:=xlSortNormal
            '再次按照随机数排序
            .Range("A3:B" & lCount + 3).Sort Key1:=.Range("B3"), _
                Order1:=xlAscending, Header:=xlYes, _
                OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
                DataOption1:=xlSortNormal
          
           
            '音乐效果一共18秒
            PlayBackLoop
            '建立总数量间的循环
            For lCT = lCount To 1 Step -1
                '改变开始序号，以期望获得26个对应的数值
                With Worksheets("PLAY")
                    For i = 1 To 26
                        TT = (lCT + i - 1) Mod (lCount)
                        If TT = 0 Then TT = lCount
                        .Range("J" & i + 2) = Sheets("Sheet1").Cells(TT + 3, 1)
                        If Range("J" & i + 2).Interior.Color = RGB(255, 0, 0) Then
                            Range("J" & i + 2).Interior.Color = RGB(60, 160, 230)
                            Range("I" & i + 2).Interior.Color = RGB(213, 213, 213)
                            Range("K" & i + 2).Interior.Color = RGB(213, 213, 213)
                            Range("G1").Interior.ColorIndex = 13
                            Range("H1").Interior.ColorIndex = 32
                            Range("J1").Interior.ColorIndex = 46
                            Range("L1").Interior.ColorIndex = 38
                            Range("M1").Interior.ColorIndex = 4
                           
                        Else
                            Range("J" & i + 2).Interior.Color = RGB(255, 0, 0)
                            Range("I" & i + 2).Interior.Color = RGB(153, 153, 153)
                            Range("K" & i + 2).Interior.Color = RGB(153, 153, 153)
                            Range("G1").Interior.ColorIndex = 4
                            Range("H1").Interior.ColorIndex = 13
                            Range("J1").Interior.ColorIndex = 32
                            Range("L1").Interior.ColorIndex = 46
                            Range("M1").Interior.ColorIndex = 38
                           
                        End If
                    Next
                End With
            Next
            '停止音效
            PlayBackStop
            '提取节点
            bOK = AddNumbers(Range("Result").Value)
            If bOK = False Then MsgBox ("您取得的数值是" & Range("Result").Value & ",此数值重复，转盘将再次运行")
            Range("G1").Interior.ColorIndex = 27
            Range("H1").Interior.ColorIndex = 27
            Range("J1").Interior.ColorIndex = 27
            Range("L1").Interior.ColorIndex = 27
            Range("M1").Interior.ColorIndex = 27
        Loop
    End With
    Application.Wait Now + TimeValue("00:00:01")
    Range("Result").Speak
End Sub
         
Function AddNumbers(lValue As Long) As Boolean
    Dim ocell As Range
    Dim oSh As Worksheet
    Set oSh = Worksheets("Sheet1")
    Set ocell = oSh.Range("i2:i1000").Find(lValue, oSh.Range("i2"), xlValues, xlWhole, , xlNext, False, , False)
    '在已经提取的列表中没有，那么写入，返回值是True
    If ocell Is Nothing Then
        AddNumbers = True
        oSh.Range("i" & oSh.Rows.Count).End(xlUp).Offset(1).Value = lValue
    Else
        AddNumbers = False
    End If
End Function
         
代码截图：
代码讲解：
 1） Do While .Cells(i, 1) <> ""
       .Cells(i, 2) = WorksheetFunction.RandBetween(1, lCount * 10)
        i = i + 1
      Loop
  以上代码会产生随机数，用于乱序排序。
 2）.Range("A3:B" & lCount + 3).Sort Key1:=.Range("A3"), _
                Order1:=xlAscending, Header:=xlYes, _
                OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
                DataOption1:=xlSortNormal
    '再次按照随机数排序
    .Range("A3:B" & lCount + 3).Sort Key1:=.Range("B3"), _
                Order1:=xlAscending, Header:=xlYes, _
                OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
                DataOption1:=xlSortNormal
  以上代码是两次排序，第一次是打乱初始录入的人员序号，第二次是乱序排序，经过这两次排序，希望对每个参与游戏者都是公平的。
 3）For i = 1 To 26
       TT = (lCT + i - 1) Mod (lCount)
          If TT = 0 Then TT = lCount
          .Range("J" & i + 2) = Sheets("Sheet1").Cells(TT + 3, 1)
          If Range("J" & i + 2).Interior.Color = RGB(255, 0, 0) Then
          Range("J" & i + 2).Interior.Color = RGB(60, 160, 230)
          Range("I" & i + 2).Interior.Color = RGB(213, 213, 213)
          Range("K" & i + 2).Interior.Color = RGB(213, 213, 213)
          Range("G1").Interior.ColorIndex = 13
          Range("H1").Interior.ColorIndex = 32
          Range("J1").Interior.ColorIndex = 46
          Range("L1").Interior.ColorIndex = 38
          Range("M1").Interior.ColorIndex = 4
                           
      Else
       Range("J" & i + 2).Interior.Color = RGB(255, 0, 0)
       Range("I" & i + 2).Interior.Color = RGB(153, 153, 153)
       Range("K" & i + 2).Interior.Color = RGB(153, 153, 153)
       Range("G1").Interior.ColorIndex = 4
       Range("H1").Interior.ColorIndex = 13
       Range("J1").Interior.ColorIndex = 32
       Range("L1").Interior.ColorIndex = 46
       Range("M1").Interior.ColorIndex = 38
                           
     End If
  Next
以上代码有两个功能，一是完成数值的填充，一是进行颜色的调整。填充的数值来自固定的RANGE,颜色的填充是按照一定的规律进行。
 4） bOK = AddNumbers(Range("Result").Value)
这句代码是获得结果，同时验证结果。利用了一个自定义函数AddNumbers，将获得的结果存储，如果结果已经存在于列表中，那么返回的bOK是TRUE，而如果我们转盘定义为幸运观众，同一人不可能出现两次中奖，那么我们要让转盘再次转动。
5）Range("G1").Interior.ColorIndex = 27
   Range("H1").Interior.ColorIndex = 27
   Range("J1").Interior.ColorIndex = 27
   Range("L1").Interior.ColorIndex = 27
   Range("M1").Interior.ColorIndex = 27
这段代码是取消“幸运大转盘”五个字的动画效果。
         
         
         
【待续】
         
         
我20多年的VBA实践经验，全部浓缩在下面的各个教程中：
         
       
 【分享成果，随喜正能量】 我们平常说祝福未来的精彩，其实是活好今天的信心、细水长流的日子、踏实冷静的面对和努力去呈现的一个个体的价值、个体的精神、个体的风采在群体当中的一种融合、担当和责任。。
         

vba
文章转载自VBA语言専攻，如果涉嫌侵权，请发送邮件至：contact@modb.pro进行举报，并提供相关证据，一经查实，墨天轮将立刻删除相关内容。

评论