Excel VBA制作象棋与魔幻方格

我个人比较喜欢玩象棋，最近在探索VBA，便编了下面几个好玩的东西，实用性不大，但对学习VBA有很大帮助。

1.中国象棋

Sub 中国象棋()
'2015-02-03 俊学之道于厦门原创
Cells.Select '全选
'去除边框线
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
Selection.Borders(xlEdgeLeft).LineStyle = xlNone
Selection.Borders(xlEdgeTop).LineStyle = xlNone
Selection.Borders(xlEdgeBottom).LineStyle = xlNone
Selection.Borders(xlEdgeRight).LineStyle = xlNone
Selection.Borders(xlInsideVertical).LineStyle = xlNone
Selection.Borders(xlInsideHorizontal).LineStyle = xlNone
'去除文字
Cells.Delete
Cells.ColumnWidth = 10 '列宽
Cells.RowHeight = 65 '行高
Rows(1).RowHeight = 10 '行高
Columns("A:A").ColumnWidth = 1 '列宽
'-------------------------------------------------------
'棋盘的全体设置
Range("B2:I10").Select
'左框线
With Selection.Borders(xlEdgeLeft)
.Weight = xlMedium '线宽大小
End With
'顶部横线
With Selection.Borders(xlEdgeTop)
.Weight = xlMedium '线宽大小
End With
'底部横线
With Selection.Borders(xlEdgeBottom)
.Weight = xlMedium
End With
'右框线
With Selection.Borders(xlEdgeRight)
.Weight = xlMedium
End With
'内竖线
With Selection.Borders(xlInsideVertical)
.Weight = xlThin
End With
'内横线
With Selection.Borders(xlInsideHorizontal)
.Weight = xlThin
End With
'------------------------------------------------------
'中部设置
Range("B6:I6").Select
'去除内竖线
Selection.Borders(xlInsideVertical).LineStyle = xlNone
'------------------------------------------------------
'下对角线
Range("E2,F3,E9,F10").Select
With Selection.Borders(xlDiagonalDown)
.Weight = xlThin
End With
'上对角线
Range("F2,E3,F9,E10").Select
With Selection.Borders(xlDiagonalUp)
.Weight = xlThin
End With
'------------------------------------------------------
'文字及字体设置
Range("C6") = "楚河"
Range("H6") = "汉界"
Range("6:6").Select
With Selection.Font
.Name = "华文隶书"
.Size = 38
End With
'去除网格线，可用0代替
ActiveWindow.DisplayGridlines = False
Range("A1").Select
End Sub

中国象棋效果图.png

2.国际象棋

Sub 国际象棋()
Cells.ColumnWidth = 10 '列宽
Cells.RowHeight = 62 '行高
'遍历
For i = 1 To 4
For j = 1 To 4
'第一色块
Cells(2 * i - 1, 2 * j - 1).Interior.ColorIndex = 40
'第二色块
Cells(2 * i - 1, 2 * j).Interior.ColorIndex = 53
'第三色块
Cells(2 * i, 2 * j - 1).Interior.ColorIndex = 53
'第四色块
Cells(2 * i, 2 * j).Interior.ColorIndex = 40
Next
Next
Range("A1").Select '回到起始单元格
ActiveWindow.DisplayGridlines = False '去除网格线，可用0代替
End Sub
'2015-02-03 俊学之道于厦门原创

国际象棋效果图.png

3.魔幻方格

Sub 遍历产生魔幻方格()
Cells.ColumnWidth = 2 '列宽
Cells.RowHeight = 15 '行高
'去除原有填充
Cells.Interior.ColorIndex = xlNone
'遍历
For i = 1 To 50
For j = 1 To 50 'j<=128
Cells(2 * i - 1, 2 * j - 1).Interior.ColorIndex = 7
Cells(2 * i, 2 * j).Interior.ColorIndex = 3
Next
Next
Range("A1").Select '回到起始单元格
End Sub
'2015-02-03 俊学之道于厦门原创

黑白魔幻方格.png

彩色魔幻方格.png