笔者在头条发布的《福彩双色球幻圆图的VBA程序（第二部分）》中，给出了绘制福彩双色球幻圆图的VBA程序。这个程序当时只考虑了幻圆图的圆环和米子型轴线的直接绘制，而且数字球没有给出相应的坐标，须要利用者手动移动到圆环与轴线的交汇点上，对付利用者来说，不太方便。
图1 原程序给出的绘制效果图
经友友们的建议，将这个程序作了调度，能够在利用者输入布局坐标后，程序自动一键绘制幻圆图，极大的方便了利用者。
Excel表格的坐标规定，左上角为（0，0），坐标值为像素值；表格横向向右x轴值增大，表格顶部向下y轴值增大，如图。
图2 Excel表格坐标出发点解释图
新的一键绘制幻圆图的程序放在宏里面或放在命令按钮里均可，运行后前后涌现两个对话框，提示输入欲绘制位置的x轴、y轴坐标值。
图3 x轴坐标输入对话框
图4 y轴坐标输入对话框
新的一键绘制幻圆图的程序效果如下
图5 新绘制的幻原图效果
程序如下。
Private Sub CommandButton1_Click()Dim shapeCount As IntegerDim i As IntegerDim x As StringDim y As Stringx = InputBox("", "x轴坐标")If x = "" Then MsgBox "您没有输入数据" Else MsgBox "您输入的x轴坐标=" & xEnd Ify = InputBox("", "y轴坐标")If y = "" Then MsgBox "您没有输入数据" Else MsgBox "您输入的y轴坐标=" & yEnd If'批量画直线（轴线）For i = 1 To 4 ActiveSheet.Shapes.AddConnector(msoConnectorStraight, 120 + (x - 111), 150 + (y - 20), 360 + (x - 111), 150 + (y - 20)). _ Select '将形状重命名为"Line" & i Selection.Name = "Line" & i Selection.ShapeRange.Rotation = (i - 1) 45 Application.CommandBars("Format Object").Visible = False '设置形状边框颜色——玄色 With Selection.ShapeRange.line .Visible = msoTrue .ForeColor.RGB = RGB(0, 0, 0) .Transparency = 0 End WithNext i'批量画圆shapeCount = 4For i = 1 To shapeCount '在活动事情表上添加新的形状—msoShapeOval(圆形) ActiveSheet.Shapes.AddShape(msoShapeOval, 210 + (1 - i) 30 + (x - 111), 120 + (1 - i) 30 + (y - 20), 60 i, 60 i).Select '将形状重命名为"Round " & i Selection.Name = "Round " & i '设置形状边框颜色——玄色 With Selection.ShapeRange.line .Visible = msoTrue .ForeColor.RGB = RGB(0, 0, 0) .Transparency = 0 End With '添补形状颜色——白色 With Selection.ShapeRange.Fill .Visible = msoFalse End WithNext i'设置要创建的形状数量33个红球shapeCount = 33 For i = 1 To shapeCount '在活动事情表上添加新的形状—msoShapeOval(圆形) ActiveSheet.Shapes.AddShape(msoShapeOval, 100 + (i - 1) 10, 100 + (i - 1), 20, 20).Select '将形状重命名为"redball" & i Selection.Name = "redball" & i '填充数字1至33 Selection.ShapeRange.TextFrame2.TextRange.Characters.Text = i Selection.ShapeRange.TextFrame2.VerticalAnchor = msoAnchorMiddle Selection.ShapeRange.TextFrame2.TextRange.ParagraphFormat.Alignment = msoAlignCenter Selection.ShapeRange.TextFrame2.WordWrap = msoFalse '添补字体颜色——玄色 With Selection.ShapeRange.TextFrame2.TextRange.Font.Fill .Visible = msoTrue .ForeColor.RGB = RGB(0, 0, 0) .Transparency = 0 .Solid End With '设置形状边框颜色——玄色 With Selection.ShapeRange.line .Visible = msoTrue .ForeColor.RGB = RGB(0, 0, 0) .Transparency = 0 End With '添补形状颜色——白色 With Selection.ShapeRange.Fill .Visible = msoTrue .ForeColor.RGB = RGB(255, 255, 255) .Transparency = 0 .Solid End WithNext i'红球坐标Set shp = ActiveSheet.Shapes("redball13") shp.left = 230 + (x - 111) shp.top = 20 + (y - 20)Set shp = ActiveSheet.Shapes("redball21") shp.left = 230 + (x - 111) shp.top = 50 + (y - 20)Set shp = ActiveSheet.Shapes("redball33") shp.left = 230 + (x - 111) shp.top = 80 + (y - 20)Set shp = ActiveSheet.Shapes("redball1") shp.left = 230 + (x - 111) shp.top = 110 + (y - 20)Set shp = ActiveSheet.Shapes("redball17") shp.left = 230 + (x - 111) shp.top = 140 + (y - 20)Set shp = ActiveSheet.Shapes("redball23") shp.left = 230 + (x - 111) shp.top = 170 + (y - 20)Set shp = ActiveSheet.Shapes("redball3") shp.left = 230 + (x - 111) shp.top = 200 + (y - 20)Set shp = ActiveSheet.Shapes("redball16") shp.left = 230 + (x - 111) shp.top = 230 + (y - 20)Set shp = ActiveSheet.Shapes("redball26") shp.left = 230 + (x - 111) shp.top = 260 + (y - 20)Set shp = ActiveSheet.Shapes("redball8") shp.left = 111 + (x - 111) shp.top = 140 + (y - 20)Set shp = ActiveSheet.Shapes("redball28") shp.left = 141 + (x - 111) shp.top = 140 + (y - 20)Set shp = ActiveSheet.Shapes("redball5") shp.left = 171 + (x - 111) shp.top = 140 + (y - 20)Set shp = ActiveSheet.Shapes("redball27") shp.left = 201 + (x - 111) shp.top = 140 + (y - 20)Set shp = ActiveSheet.Shapes("redball7") shp.left = 260 + (x - 111) shp.top = 140 + (y - 20)Set shp = ActiveSheet.Shapes("redball19") shp.left = 290 + (x - 111) shp.top = 140 + (y - 20)Set shp = ActiveSheet.Shapes("redball31") shp.left = 320 + (x - 111) shp.top = 140 + (y - 20)Set shp = ActiveSheet.Shapes("redball11") shp.left = 350 + (x - 111) shp.top = 140 + (y - 20)Set shp = ActiveSheet.Shapes("redball14") shp.left = 146 + (x - 111) shp.top = 55 + (y - 20)Set shp = ActiveSheet.Shapes("redball2") shp.left = 166 + (x - 111) shp.top = 77 + (y - 20)Set shp = ActiveSheet.Shapes("redball20") shp.left = 190 + (x - 111) shp.top = 98 + (y - 20)Set shp = ActiveSheet.Shapes("redball32") shp.left = 209 + (x - 111) shp.top = 119 + (y - 20)Set shp = ActiveSheet.Shapes("redball22") shp.left = 252 + (x - 111) shp.top = 161 + (y - 20)Set shp = ActiveSheet.Shapes("redball12") shp.left = 272 + (x - 111) shp.top = 182 + (y - 20)Set shp = ActiveSheet.Shapes("redball4") shp.left = 294 + (x - 111) shp.top = 204 + (y - 20)Set shp = ActiveSheet.Shapes("redball30") shp.left = 315 + (x - 111) shp.top = 225 + (y - 20)Set shp = ActiveSheet.Shapes("redball9") shp.left = 314 + (x - 111) shp.top = 55 + (y - 20)Set shp = ActiveSheet.Shapes("redball24") shp.left = 292 + (x - 111) shp.top = 78 + (y - 20)Set shp = ActiveSheet.Shapes("redball29") shp.left = 271 + (x - 111) shp.top = 98 + (y - 20)Set shp = ActiveSheet.Shapes("redball6") shp.left = 251 + (x - 111) shp.top = 118 + (y - 20)Set shp = ActiveSheet.Shapes("redball18") shp.left = 209 + (x - 111) shp.top = 161 + (y - 20)Set shp = ActiveSheet.Shapes("redball15") shp.left = 188 + (x - 111) shp.top = 182 + (y - 20)Set shp = ActiveSheet.Shapes("redball10") shp.left = 166.8 + (x - 111) shp.top = 204 + (y - 20)Set shp = ActiveSheet.Shapes("redball25") shp.left = 145 + (x - 111) shp.top = 225 + (y - 20)End Sub