双色球红球走势图的VBA程序 双色球红球走势图的vba程序是什么

用自己的电脑在家里随时随地看双色球红球的走势，比起在彩票店仰着头看墙上挂着的走势图，不受任何干扰，自由自在，是一件非常惬意的事情。

其实，自己在Excel上自己做一个双色球走势图，非常简单。会操作Excel，看了下面的内容，按照说明，你就拥有了自己专属的红球走势图了。

第一步

新建一个工作簿，添加一个工作表，并重命名为“红球走势图”。

第二步

在“红球走势图”表上添加一个命名按钮，将下面的代码复制粘贴到命名按钮的Click事件里。

Dim ws As Worksheet
    Set ws = ThisWorkbook.Sheets("红球走势图") ' 修改为您的工作表名称
    
    ' 设置列的宽度
    ws.Columns("A").ColumnWidth = 9.75
    ws.Columns("B:AO").ColumnWidth = 2.25
    ws.Columns("AP:AR").ColumnWidth = 3.75
    ws.Rows("1:25").RowHeight = 14.25 ' 设置第1到第25行的行高为25

For i = 1 To 22
    For j = 1 To 6
        '在活动工作表上添加新的形状—msoShapeOval(圆形)
        ActiveSheet.Shapes.AddShape(msoShapeOval, 140, 30 + (i - 1) * 14.26, 12, 12).Select
        Selection.Placement = xlFreeFloating
        Application.CommandBars("Format Object").Visible = False
        
        '将形状重命名为"blueballA" & i & "B" & j
        Selection.Name = "redballA" & i & "B" & j
        Selection.ShapeRange.TextFrame2.TextRange.Characters.Text = ""
        
        ' 设置形状的文本效果属性
        With Selection.ShapeRange.TextEffect
            .FontName = "Calibri"
            .fontSize = 11
            .Text = "1"
        End With

        ' 设置形状边框颜色——红色
        With Selection.ShapeRange.line
            .Visible = msoTrue
            .ForeColor.RGB = RGB(255, 0, 0)
            .Transparency = 0
        End With

        ' 填充形状颜色——红色
        With Selection.ShapeRange.Fill
            .Visible = msoTrue
            .ForeColor.RGB = RGB(255, 0, 0)
            .Transparency = 0
            .Solid
        End With

        ' 设置文本格式
        With Selection.ShapeRange.TextFrame2
            .VerticalAnchor = msoAnchorMiddle
            .HorizontalAnchor = msoAnchorCenter
            .WordWrap = msoFalse
        End With

    Next
Next

第三步

添加一个滚动条（ActiveX控件)，并设置其属性。

将下面的代码复制粘贴到滚动条的Change事件里。

Dim i As Integer
Dim j As Integer

Sheets("Data").Select
'统计期数 彩票期数(Number of Lottery Periods)NoLP
NoLP = ActiveSheet.UsedRange.Rows.count - 2

Sheets("红球走势图").Select
ScrollBar1.Max = NoLP
ScrollBar1.Min = 22

For i = 1 To 22
    For j = 1 To 6
        Sheets("红球走势图").Cells(i + 2, 1).Value = Sheets("Data").Cells((ScrollBar1.Value - 22) + i + 2, 1).Value & "期"
        Sheets("红球走势图").Cells(i + 2, j + 1).Value = Sheets("Data").Cells((ScrollBar1.Value - 22) + i + 2, j + 9).Value
    Next
Next

Range("AR3:AR24").NumberFormatLocal = "@" '设置文本显示

Dim rng As Range
Dim cell As Range
Dim evenNumber As Integer
Dim oddNumber As Integer

For i = 1 To 22
    For j = 1 To 6
        Set shp = ActiveSheet.Shapes("redballA" & i & "B" & j)
        shp.TextFrame2.TextRange.Characters.Text = Cells(i + 2, j + 1).Value
        shp.left = 203 + (Cells(i + 2, j + 1).Value - 2) * 17.23
        
        Cells(i + 2, 42) = Application.sum(Range("B" & i + 2 & ":G" & i + 2)) '和值
        Cells(i + 2, 43) = Application.Max(Range("B" & i + 2 & ":G" & i + 2)) - Application.Min(Range("B" & i + 2 & ":G" & i + 2)) '极距
        evenNumber = 0
        oddNumber = 0
        Set rng = ThisWorkbook.Sheets("红球走势图").Range("B" & i + 2 & ":G" & i + 2)
        For Each cell In rng
            If Val(cell.Value) Mod 2 = 0 Then  '偶数
               evenNumber = evenNumber + 1
            Else '奇数
               oddNumber = oddNumber + 1
            End If
        Next cell
        Cells(i + 2, 44) = oddNumber & ":" & evenNumber
   Next
Next

第四步

准备双色球历年开奖数据。这一部分，进入我的主页，看《福彩双色球幻圆图的VBA程序（第三部分）》，按上面讲的做就可以了。

第五步

点击保存，运行结果如图