我個人比較喜歡玩象棋，最近在探索VBA，便編了下面幾個好玩的東西坪蚁，實(shí)用性不大余素，但對學(xué)習(xí)VBA有很大幫助豹休。
1.中國象棋
Sub 中國象棋()
'2015-02-03 俊學(xué)之道于廈門原創(chuàng)
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 '列寬
'-------------------------------------------------------
'棋盤的全體設(shè)置
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
'內(nèi)豎線
With Selection.Borders(xlInsideVertical)
.Weight = xlThin
End With
'內(nèi)橫線
With Selection.Borders(xlInsideHorizontal)
.Weight = xlThin
End With
'------------------------------------------------------
'中部設(shè)置
Range("B6:I6").Select
'去除內(nèi)豎線
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
'------------------------------------------------------
'文字及字體設(shè)置
Range("C6") = "楚河"
Range("H6") = "漢界"
Range("6:6").Select
With Selection.Font
.Name = "華文隸書"
.Size = 38
End With
'去除網(wǎng)格線，可用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 '去除網(wǎng)格線桨吊，可用0代替
End Sub
'2015-02-03 俊學(xué)之道于廈門原創(chuàng)
國際象棋效果圖.png
3.魔幻方格
Sub 遍歷產(chǎn)生魔幻方格()
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 俊學(xué)之道于廈門原創(chuàng)
黑白魔幻方格.png
彩色魔幻方格.png
