前言

看到這個題目，想必你一定會感到非常驚訝，什么，Excel居然能開發游戲？

沒錯，Excel的強大取決于使用者，遇強則強，遇弱則弱。

但我這篇文章并不是為了展示Excel使用過程中的奇技淫巧，而是主要寫給那些準備學習編程但又沒什么計算機基礎的那些人，或者對Excel感興趣的那些人。

如果這篇文章對你有一定幫助，我希望你能夠將這片文章分享出去，讓更多的人看到；如果你已經是一名有經驗的開發者，我也希望你能提出寶貴的意見。

對于那些正在學習編程的人，尤其是那些從其他領域跨入這個行業的人，興趣才是最大的動力。我從事計算機編程這么長時間，感覺編程是一件非常有意義的事情。

然而我卻我經常聽到有些人，尤其是那些在校學生們抱怨說編程學起來太枯燥了，堅持不下去。

覺得這部分人一方面是方向錯了，另一方面就是在實際學習過程中對自己做出成果沒有任何的成就感，而后者，往往占據了重要原因。

我認為，對于編程的初學者，選擇第一門語言應該具備下面兩個特點：

1）盡可能簡單，盡量少與底層硬件（諸如內存管理等）相關聯，調試方便，IDE界面簡單；

2）功能相對強大，能開發各種小插件工具；

就目前行業內比較常用的編程語言中，能夠同時滿足上述兩個特點的也就數Python,office for VBA,Java了，然而，Python雖然簡單功能又強大，但是需要配置環境，而且要安裝臃腫的IDE，這些對于初學者來說，無形之中又增加了學習成本，更別說Java了，所以剩下的就數VBA(Visual Basic for Application)了。

VBA屬于visual basic語言的子集，除了繼承了部分vb功能外，還特意針對一些軟件做了接口封裝，使用方便。有人說VBA語法太隨意，對于初學者不是件好事，如果學C的話，將來學C++就簡單很多了。

我不同意這種觀點，對于前者，仁者見仁，但后者就是在扯淡，因為C++是一門極其復雜的編程語言，除了繼承了C的繁瑣指針以外，還衍生出了諸如多重繼承、類模板、智能指針等恐怖級別的編程范式，所以說，對于初學者，我不建議直接就去學C++.

為什么選擇VBA作為初學者的語言呢，因為他除了滿足上面所說的兩個特點外，還有一些其他的優點，諸如：

1）使用簡單：不需要安裝開發工具，更不需要配環境、安裝語言包，只要你電腦里面有office軟件即可。

2）用途廣泛：幾乎所有的工程軟件、辦公軟件都支持用VBA做二次開發，例如財務人員如果發現Excel自帶的公式有局限性的話，完全可以自己用VBA開發自己需要的控件；

機械設計人員如果學了VBA后可以開發一些自己需要的代碼塊，極大程度地提高自己CAD的繪圖速度。很難想象，Excel的重度用戶尤其是財務人員不懂VBA的話他的工作量有多可怕。

3）調試簡單方便。

所以，這次我也選擇VBA作為這次編寫Demo的語言，為了照顧更多的初學者，我將每一步的細節都盡可能地呈現出來，由于每個Excel版本不一樣，我電腦用的是2010版的。

所以，我就用2010版進行說明，其他版本也一樣，只是界面可能稍有區別。我相信，只要親手按照我的方法做出這個游戲，除了你將認識到Excel的強大之處外，你也將逐步體會到編程的樂趣。

鑒于時間所限，內容可能有部分疏忽之處，還望大家提出改正。

游戲框架

首先看一下游戲最終大致的效果圖：

首先我們思考一下俄羅斯方塊游戲的大致架構：

1）初始化界面：創建方塊所需要的地圖。

2）隨機生成俄羅斯方塊：俄羅斯方塊總共有7種形態，每種形態均有4個框格組成，每種方塊各對應一種顏色。可以創建一個數組存儲每種方塊的坐標，再用另外一個數組存儲方塊的對應的顏色。

3）移動旋轉方塊：分為向左，向右，向下。擦拭完后重新繪制，產生移動旋轉的效果。

4）沒產生新的方塊，都進行一定速度的下落，一旦碰到障礙物，不能下落，再生成新的方塊。

5）不斷掃描是否有任何一行填滿，如果為真，則本行刪除，上面下落。每行積分為10分。

開發過程

首先創建一個Excel文件，隨意命名。打開后，由于office默認隱藏了開發工具狀態欄，所以我們需要在Excel選項>自定義功能區將其調出來，將其勾選后確認：

隨后，我們發現主界面多了開發工具的選項：

我們再在Sheet1表格里面將A~K列的列寬大致調成跟行高一樣，讓它大致稱為一個正方形的區域：

我們點擊Visual Basic菜單，打開編寫代碼界面，我們插入首先插入一個代碼模塊，用于編寫我們自己的代碼：

由于方塊有7中形狀，為了讓程序繪制方便，我用一個三維數組存儲所有形狀的坐標，每種形狀都有一個中心坐標(0,0)，其余三個方框的坐標按照中心坐標來計算相對坐標，例如丁字形狀的方塊：

如果中心的坐標為(0,0)的話，剩余三個從右到左逆時針三個坐標分別為(0,1),(-1,0),(0,-1)，之所以將垂直方向作為X軸是因為Excel坐標的固有屬性。

例如Cells(1,2)代表第一行第二列個單元格。每個方塊的對象有中心坐標，顏色，形狀等屬性，所以我們需要定義幾個模塊變量，代碼如下：

Option Explicit

Dim MySheet As Worksheet
Dim iCenterRow As Integer '方塊中心行
Dim iCenterCol As Integer '方塊中心列
Dim ColorArr() '7種顏色
Dim ShapeArr() '7種方塊
Dim iColorIndex As Integer '顏色索引
Dim MyBlock(4, 2) As Integer '每個方框的坐標數組，會隨著方塊的移動而變化
Dim bIsObjectEnd As Boolean '本個方塊是否下降到最低點
Dim iScore As Integer '分數

考慮到每種方塊坐標的不一樣，所以我采用一個三維數組來存儲方塊坐標，為了方便，我采用VBA自帶的接口Array()函數給自己的ShapeArr()賦值。

同時要在主界面上顯示出玩家的分數，所以這兩個功能我們作為一個初始化函數，我們定義一個Init()子過程，代碼如下：

'初始化 By@yaxi_liu
Private Sub Init()
Set MySheet = Sheets("Sheet1")
ColorArr = Array(3, 4, 5, 6, 7, 8, 9)
ShapeArr = Array(Array(Array(0, 0), Array(0, 1), Array(0, -1), Array(0, 2)), _
Array(Array(0, 0), Array(0, 1), Array(0, -1), Array(-1, -1)), _
Array(Array(0, 0), Array(0, 1), Array(0, -1), Array(-1, 1)), _
Array(Array(0, 0), Array(-1, 1), Array(-1, 0), Array(0, 1)), _
Array(Array(0, 0), Array(0, -1), Array(-1, 0), Array(-1, 1)), _
Array(Array(0, 0), Array(0, 1), Array(-1, 0), Array(-1, -1)), _
Array(Array(0, 0), Array(0, 1), Array(0, -1), Array(-1, 0)))

With MySheet.Range("B1:K20")
.Interior.Pattern = xlNone
.Borders.LineStyle = xlNone

.Borders(xlEdgeBottom).Weight = xlMedium
.Borders(xlEdgeRight).Weight = xlMedium
.Borders(xlEdgeLeft).Weight = xlMedium
End With

'設定長寬比例
MySheet.Columns("A:L").ColumnWidth = 2
MySheet.Rows("1:30").RowHeight = 13.5

iScore = 0
MySheet.Range("N1").Value = "分數"
MySheet.Range("O1").Value = iScore
End Sub

這時候，我們初始化變量與功能的函數基本上實現了。下一步我們要編寫生成一個新方塊的函數，為了實現程序的模塊化，低耦合，我們將本功能封裝成一個獨立的函數。

由于繪制函數DrawBlock()需要根據傳遞過來的做標數組來進行繪制，同時我們需要知道這個方塊的中心坐標在哪里，還有對應的顏色，所以我們需要傳遞4個參數，其中數組需要傳址(ByRef)，代碼如下：

'繪制方塊，By@yaxi_liu
Private Sub DrawBlock(ByVal center_row As Integer, ByVal center_col As Integer, ByRef block() As Integer, ByVal icolor As Integer)
Dim Row As Integer, Col As Integer
Dim i As Integer
For i = 0 To 3
Row = center_row + block(i, 0)
Col = center_col + block(i, 1)
MySheet.Cells(Row, Col).Interior.ColorIndex = icolor '顏色索引
MySheet.Cells(Row, Col).Borders.LineStyle = xlContinuous '周圍加外框線
Next
End Sub

至此，繪制函數已經完成，為了防止Bug出現，我們需要測試一下，我們再定義一個入口函數，Start(),同時定義一個臨時方塊數組，調用DrawBlock()進行測試。在主界面添加一個按鈕，將其指定到Start函數，并將其拖入合適的位置：

Start函數代碼如下：

Sub Start()
Call Init

iCenterRow = 5
iCenterCol = 6
iColorIndex = 4
Dim i As Integer
For i = 0 To 3
MyBlock(i, 0) = ShapeArr(iColorIndex)(i)(0)
MyBlock(i, 1) = ShapeArr(iColorIndex)(i)(1)
Next
Call DrawBlock(iCenterRow, iCenterCol, MyBlock, ColorArr(iColorIndex))
End Sub

我們運行一下，看看效果：

好，測試結果顯示完全沒問題。

由于后期我們需要在表格最上方的固定位置不斷隨機生成新的方塊，所以我們應該將此功能再次封裝為一個獨立函數，為了防止產生偽隨機數，我們采用Timer作為當前種子，隨機生成0~6之間的數組，每個對應形狀數組與顏色數組的索引，代碼如下：

'隨機生成新的方塊函數 By@yaxi_liu
Private Sub GetBlock()
Randomize (Timer)
Dim i As Integer
iColorIndex = Int(7 * Rnd)
iCenterRow = 2
iCenterCol = 6

For i = 0 To 3
MyBlock(i, 0) = ShapeArr(iColorIndex)(i)(0)
MyBlock(i, 1) = ShapeArr(iColorIndex)(i)(1)
Next
Call DrawBlock(iCenterRow, iCenterCol, MyBlock, ColorArr(iColorIndex))
End Sub

既然生成了方塊，我們就要讓方塊能夠左右下移動，分為三個方向。移動的方法是首先擦除掉當前的方塊，再根據規定的移動方向，計算新的坐標，再根據新的坐標重新繪制，這樣就產生了移動的現象。但是，在移動之前，我們需要判斷是否可以移動。

首先，我們需要編寫判斷是否能夠移動或者旋轉的函數CanMoveRotate，此函數很簡單，也就是將移動后或者旋轉后的坐標傳遞過來，判斷是否越界，或者當前位置上是否有其他顏色即可，代碼如下：

'是否能夠移動或者旋轉函數，By@yaxi_liu
Private Function CanMoveRotate(ByVal center_row As Integer, ByVal center_col As Integer, ByRef block() As Integer) As Boolean
'本函數形參均為變換后的坐標

'首先判斷是否越界
Dim Row As Integer, Col As Integer
Dim i As Integer
CanMoveRotate = True
For i = 0 To 3
Row = center_row + block(i, 0)
Col = center_col + block(i, 1)
If Row > 20 Or Row < 0 Or Col > 11 Or Col < 2 Then '越界
CanMoveRotate = False
End If
If MySheet.Cells(Row, Col).Interior.Pattern <> xlNone Then '只要有一個顏色，則為阻擋
CanMoveRotate = False
End If
Next
End Function

我們還需要一個擦除當前方塊的函數EraseBlock，根據傳遞過來的坐標直接擦拭掉，代碼如下：

'擦除方塊 By@yaxi_liu
Private Sub EraseBlock(ByVal center_row As Integer, ByVal center_col As Integer, ByRef block() As Integer)
Dim Row As Integer, Col As Integer
Dim i As Integer
For i = 0 To 3
Row = center_row + block(i, 0)
Col = center_col + block(i, 1)
MySheet.Cells(Row, Col).Interior.Pattern = xlNone
MySheet.Cells(Row, Col).Borders.LineStyle = xlNone
Next
End Sub

我們再編寫移動方塊的函數MoveBlock，我們規定，形參direction代表方向，-1代表向左，0代表向下，1代表向右，注意移動后需要保存當前坐標。新增形參direction，代碼如下：

'移動方塊 By@yaxi_liu
Private Sub MoveBlock(ByVal center_row As Integer, ByVal center_col As Integer, ByRef block() As Integer, ByVal icolor As Integer, ByVal direction As Integer)
Dim Row As Integer, Col As Integer
Dim i As Integer
Dim old_row As Integer, old_col As Integer '保存最早的中心坐標
old_row = center_row
old_col = center_col

'首先擦除掉原來位置的
Call EraseBlock(center_row, center_col, block)

'-1 代表向左，1 代表向右，0 代表鄉下
Select Case direction
Case Is = -1
center_col = center_col - 1
Case Is = 1
center_col = center_col + 1
Case Is = 0
center_row = center_row + 1
End Select

'再繪制
If CanMoveRotate(center_row, center_col, block) Then
Call DrawBlock(center_row, center_col, block, icolor)
'保存中心坐標
iCenterRow = center_row
iCenterCol = center_col
Else
Call DrawBlock(old_row, old_col, block, icolor)
'保存中心坐標
iCenterRow = old_row
iCenterCol = old_col
If direction = 0 Then
bIsObjectEnd = True
End If
End If

'保存方塊坐標
For i = 0 To 3
MyBlock(i, 0) = block(i, 0)
MyBlock(i, 1) = block(i, 1)
Next

End Sub

移動方塊實現后，我們再來編寫旋轉方塊函數RotateBlock，這里我們統一規定為逆時針旋轉。跟移動函數一樣，方法也是先擦除掉舊坐標的后，再根據新坐標繪制出新的方塊。只不過旋轉稍微麻煩一點。

不難計算出，假如一個向量(x,y)在逆時針旋轉90度后的坐標為(-y,x).根據這個公式，編寫旋轉函數。但是注意事先應該先判斷是否達到旋轉的條件。代碼如下：

'旋轉方塊函數 By@yaxi_liu
Private Sub RotateBlock(ByVal center_row As Integer, ByVal center_col As Integer, ByRef block() As Integer, ByVal icolor As Integer)
Dim i As Integer
'先擦除原來的
Call EraseBlock(center_row, center_col, block)
Dim tempArr(4, 2) As Integer
'保存數組
For i = 0 To 3
tempArr(i, 0) = block(i, 0)
tempArr(i, 1) = block(i, 1)
Next
'旋轉后的坐標重新賦值
For i = 0 To 3
block(i, 0) = -tempArr(i, 1)
block(i, 1) = tempArr(i, 0)
Next i

'重新繪制新的方塊
If CanMoveRotate(center_row, center_col, block) Then
Call DrawBlock(center_row, center_col, block, icolor)
'保存方塊坐標
For i = 0 To 3
MyBlock(i, 0) = block(i, 0)
MyBlock(i, 1) = block(i, 1)
Next
Else
Call DrawBlock(center_row, center_col, tempArr, icolor)
'保存方塊坐標
For i = 0 To 3
MyBlock(i, 0) = tempArr(i, 0)
MyBlock(i, 1) = tempArr(i, 1)
Next
End If

'保存中心坐標
iCenterRow = center_row
iCenterCol = center_col

End Sub

這時候，旋轉、移動函數均已編寫完畢。為了能夠讓游戲相應鍵盤事件，我們需要在對應的工作表代碼層添加事件函數，注意這里我們需要調用Windows API。

我們規定鍵盤的左鍵為方塊向左MoveObject(-1)，右鍵為方塊向右MoveObject(1)，下鍵為方塊向下MoveObject(0)，上鍵為方塊旋轉RotateObject()。我們再Sheet1工作表里面編寫如下WorkSheet事件代碼：

'鍵盤事件代碼，By@yaxi_liu
#If VBA7 And Win64 Then
Private Declare PtrSafe Function GetKeyboardState Lib "user32" (pbKeyState As Byte) As Long
#Else
Private Declare Function GetKeyboardState Lib "user32" (pbKeyState As Byte) As Long
#End If
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim keycode(0 To 255) As Byte
GetKeyboardState keycode(0)
If keycode(38) > 127 Then '上
Call RotateObject
ElseIf keycode(39) > 127 Then '右
Call MoveObject(1)
ElseIf keycode(40) > 127 Then '下
Call MoveObject(0)
ElseIf keycode(37) > 127 Then '左
Call MoveObject(-1)
End If
End Sub

由于我們自己定義的MoveBlock與RotateBlock包類對象的形參，因此事件響應中不能直接調用。

在這里我們將用兩個 Public 的MoveObject與RotateObject函數在類模塊里面再次封裝，方便事件調用，代碼如下：

'移動對象 By@yaxi_liu
Public Sub MoveObject(ByVal dir As Integer)
Call MoveBlock(iCenterRow, iCenterCol, MyBlock, ColorArr(iColorIndex), dir)
End Sub

'旋轉對象 By@yaxi_liu
Public Sub RotateObject()
Call RotateBlock(iCenterRow, iCenterCol, MyBlock, ColorArr(iColorIndex))
End Sub

至此，方塊功能方面已經完全實現，我們隨機生成一個進行測試：

為了方便，我們將按鈕1里面的文字更改成“啟動游戲四個字”：

隨后，開始編寫程序自動運行的代碼。由于俄羅斯方塊是生成方塊后，按照一定的速度進行下降，一旦碰到障礙物后本方塊結束，再生成新的方塊，如此循環。由于VBA不支持定時器，所以我們采用while(true)循環的方法進行不斷生成方塊。

為了避免CPU資源過度占用，我們在循環之間加入延時函數，供循環調用，代碼如下：

'延時函數 By@yaxi_liu
Private Sub delay(T As Single)
Dim T1 As Single
T1 = Timer
Do
DoEvents
Loop While Timer - T1 < T
End Sub

在下降過程中，我們需要知道是否某一行已經滿了，判斷的方法很簡單，查詢整行是否全部涂色即可。

如果滿了，我們刪除本行，同時將第一行到本行下降填充。同時更新分數。因此我們再引入一個函數DeleteFullRow，代碼如下：

'消除滿行函數 By@yaxi_liu
Private Sub DeleteFullRow()
Dim i As Integer, j As Integer
For i = 1 To 20
For j = 2 To 11
If MySheet.Cells(i, j).Interior.ColorIndex < 0 Then
Exit For
ElseIf j = 11 Then
MySheet.Range(Cells(1, 2), Cells(i - 1, j)).Cut Destination:=MySheet.Range(Cells(2, 2), Cells(i, j)) 'Range("B2:K18")
iScore = iScore + 10
End If
Next j
Next i
MySheet.Range("N1").Value = "分數"
MySheet.Range("O1").Value = iScore
End Sub

再在Start()函數里面添加while循環，上面兩個函數一樣添加進去代碼如下：

'啟動函數By@yaxi_liuSubStart()CallInit While (True) Call GetBlock bIsObjectEnd = False '本方塊對象是否結束 While (bIsObjectEnd = False) Call delay(0.5) Call MoveBlock(iCenterRow, iCenterCol, MyBlock, ColorArr(iColorIndex), 0) MySheet.Range("L21").Select With MySheet.Range("B1:K20") .Borders(xlEdgeBottom).Weight = xlMedium .Borders(xlEdgeRight).Weight = xlMedium .Borders(xlEdgeLeft).Weight = xlMedium End With Wend Call DeleteFullRow WendEnd Sub

到這里，本游戲的編寫就算徹底結束了，點擊Sheet1界面上面的“按鈕1”按鈕即可開始游戲。

我們再試玩一下，向左鍵代表向左，右鍵代表向右，上鍵代表旋轉，下鍵代表下降。看一下效果：

哈哈，試玩結束沒問題，非常完美，過程雖然長久，但值得你細細研究，也希望你能從中夠體會到編程的樂趣。

審核編輯：劉清