Excel+VBA製作小遊戲：翻卡牌

一、工作表區域

我們先將工作表Sheet1的前5行行高修改為50，然後設置字型大小20，居中，將A1:E4這個區域加上單元格邊框，這部分操作和九宮格拼圖類似。

然後新建一個工作表Sheet2，用來存放遊戲內容。因為VBA的方法一旦執行完，內存就會釋放，所以沒法記錄遊戲內容和步驟，我們需要將一個工作表作為遊戲內存區域，並隱藏起來。

二、創建卡牌

我們先將想要使用的圖形放到一個數組中，然後利用集合將每個圖形添加2次，然後隨機取出填入到剛才的區域。代碼如下：

Public Sub Creat_Card()Sheet1.Range("A1:E4") = ""Dim graphArrgraphArr = Array("☆", "", "○", "●", "◇", "◆", "□", "", "△", "▲")Dim graphCol As New CollectionFor i = 0 To 9 graphCol.Add graphArr(i) graphCol.Add graphArr(i)Next iDim graphArea(1 To 4, 1 To 5) As StringRandomize (Timer)For i = 19 To 0 Step -1 n = Int((i + 1) * Rnd) + 1 x = Int(i / 5) + 1 y = i Mod 5 + 1 graphArea(x, y) = graphCol(n) graphCol.Remove (n)Next iSheet2.Range("A1:E4") = graphAreaEnd Sub

我們設置的區域是一個4*5的區域，20個方格里需要10個圖形，我從輸入法自帶的符號中，選了5個有實心空心區別的基本形狀作為基本卡牌。

三、翻卡牌

其實翻卡牌的動作就是點擊，我們用工作表自帶的SelectionChange事件來進行翻卡牌的操作。我們需要做的條件判斷有以下幾個：

1. 點擊的單元格是否符合條件（在區域中且為空）
2. 翻面的卡牌是奇數還是偶數
3. 翻面的卡牌是否成對
4. 卡牌是否全部翻面

其中，翻面的卡牌為奇數則直接顯示，並記錄，如果為偶數則對比之前翻面的卡牌。如果卡牌成對則保持，如果不成對則延遲一段時間並消失。代碼如下：

Private Sub Worksheet_SelectionChange(ByVal Target As Range)x = ActiveCell.Rowy = ActiveCell.ColumnIf x > 4 Or y > 5 Then Exit SubIf Sheet1.Cells(x, y) <> "" Then Exit SubSheet1.Cells(x, y) = Sheet2.Cells(x, y)If Open_Card Mod 2 = 1 Then Sheet2.Range("A5:B5") = Array(x, y)Else m = Sheet2.Cells(5, 1) n = Sheet2.Cells(5, 2) If Sheet1.Cells(x, y) <> Sheet1.Cells(m, n) Then Call Sleep(400) Sheet1.Cells(x, y) = "" Sheet1.Cells(m, n) = "" Else If Open_Card = 20 Then MsgBox "成功！", , "成功" End IfEnd IfEnd Sub

這裡有兩個需要自己添加的部分，一個是延遲方法Sleep，一個是翻開卡牌個數的函數Open_Card。Open_Card只需要讀取卡牌區域，判斷有多少單元格不為空就行了。Sleep需要引入介面，自己實現讀秒機制。代碼如下：

Public Function Open_Card() As IntegerDim graphArea, sum%graphArea = Sheet1.Range("A1:E4")For i = 1 To 4 For j = 1 To 5 If graphArea(i, j) <> "" Then sum = sum + 1 Next jNext iOpen_Card = sumEnd Function

#If VBA7 And Win64 Then Private Declare PtrSafe Function GetTickCount Lib "kernel32" () As Long#Else Private Declare Function GetTickCount Lib "kernel32" () As Long#End IfPublic Sub Sleep(numa As Double)"延時方法Dim num1 As DoubleDim num2 As DoubleDim numb As Doublenumb = 0num1 = GetTickCountDo While numa - numb > 0 num2 = GetTickCount numb = num2 - num1 DoEventsLoopEnd Sub

這個延時方法幾乎是VBA中最高效的延時方法，記錄下來十分有用。以上，程序完成。最後，在Sheet1插入一個按鈕，引用Creat_Card就可以一直刷新重玩了。

有興趣的話可以自己增加玩法，比如設置難度、增加或減少卡牌區域、增加或減少延遲時間等。代碼照例在附錄。

附錄1：模塊代碼

#If VBA7 And Win64 Then Private Declare PtrSafe Function GetTickCount Lib "kernel32" () As Long#Else Private Declare Function GetTickCount Lib "kernel32" () As Long#End IfPublic Sub Creat_Card()Sheet1.Range("A1:E4") = ""Dim graphArrgraphArr = Array("☆", "", "○", "●", "◇", "◆", "□", "", "△", "▲")Dim graphCol As New CollectionFor i = 0 To 9 graphCol.Add graphArr(i) graphCol.Add graphArr(i)Next iDim graphArea(1 To 4, 1 To 5) As StringRandomize (Timer)For i = 19 To 0 Step -1 n = Int((i + 1) * Rnd) + 1 x = Int(i / 5) + 1 y = i Mod 5 + 1 graphArea(x, y) = graphCol(n) graphCol.Remove (n)Next iSheet2.Range("A1:E4") = graphAreaEnd SubPublic Function Open_Card() As IntegerDim graphArea, sum%graphArea = Sheet1.Range("A1:E4")For i = 1 To 4 For j = 1 To 5 If graphArea(i, j) <> "" Then sum = sum + 1 Next jNext iOpen_Card = sumEnd FunctionPublic Sub Sleep(numa As Double)"延時方法Dim num1 As DoubleDim num2 As DoubleDim numb As Doublenumb = 0num1 = GetTickCountDo While numa - numb > 0 num2 = GetTickCount numb = num2 - num1 DoEventsLoopEnd Sub

附錄2：Sheet1代碼

Private Sub Worksheet_SelectionChange(ByVal Target As Range)x = ActiveCell.Rowy = ActiveCell.ColumnIf x > 4 Or y > 5 Then Exit SubIf Sheet1.Cells(x, y) <> "" Then Exit SubSheet1.Cells(x, y) = Sheet2.Cells(x, y)If Open_Card Mod 2 = 1 Then Sheet2.Range("A5:B5") = Array(x, y)Else m = Sheet2.Cells(5, 1) n = Sheet2.Cells(5, 2) If Sheet1.Cells(x, y) <> Sheet1.Cells(m, n) Then Call Sleep(400) Sheet1.Cells(x, y) = "" Sheet1.Cells(m, n) = "" Else If Open_Card = 20 Then MsgBox "成功！", , "成功" End IfEnd IfEnd Sub

推薦閱讀：