用EXCEL制作“人鬼过河”游戏

1、先做一个界面，如下图：

 

2、打开一个空白工作表，将其底部标签名字改成“手动”。

 

其中A2:A7表示A岸，D2：D7表示B岸，B2:C7充填兰色，表示河。

 

3、按上图用“窗体”工具栏添加两个按钮，分别起名为“初始化”与“过河”。

在菜单上按“视图－工具栏－窗体”调出“窗体”工具栏，如下图：

4、 

提示：这是在EXCEL2003中的“窗体”工具，如果你用的是2007版的，需要在“开发工具－插入－表单控件”，如下图：

5、 

6、在“手动”工作表的底部标签名字上按鼠标右键，从快捷菜单中选“查看代码”，调出该工作表项目的VBA窗口，并把下面代码粘贴进去。

7、Dim n '计数

 

Dim g '标志

 

Dim x1, x2, y1, y2, fx, q

 

Private Sub Worksheet_SelectionChange(ByVal Target As Range)

 

x = Target.Row

 

y = Target.Column

 

If (y = 1 Or y = 4) And (x > 1 And x < 8) And Target.Count = 1 Then

 

ActiveSheet.Unprotect

 

If n = 2 Then '超员或非同岸则复位

 

g = 0: n = 0: Call 清除颜色

 

End If

 

If y1 <> 0 And y <> y1 Then Call 清除颜色: n = 0: y1 = 0: Exit Sub

 

If n = 1 And y = y1 Then Target.Interior.ColorIndex = 6: x2 = x: y2 = y: n = n + 1: g = 1

 

If n = 0 Then Target.Interior.ColorIndex = 6: x1 = x: y1 = y: n = n + 1: g = 1

 

ActiveSheet.Protect

 

End If

 

End Sub

 

Private Sub 初始()

 

n = 0: x1 = 0: x2 = 0: y1 = 0: y2 = 0: g = 0

 

Call 清除颜色

 

End Sub

 

Private Sub 清除颜色()

 

Range("a2:a7").Interior.ColorIndex = xlNone

 

Range("d2:d7").Interior.ColorIndex = xlNone

 

End Sub

 

Sub 过河()

 

If n = 0 Then MsgBox "请选择成员": Exit Sub

 

ActiveSheet.Unprotect '撤消保护

 

q = q + 1: Range("b9") = "第 " & q & " 步"

 

If n = 1 Then

 

If Cells(x1, y1) = "" Then MsgBox "请选择成员": Exit Sub

 

If y1 = 1 Then Call yd(x1, 8, 1): Call 清除颜色

 

If y1 = 4 Then Call yd(x1, 8, -1): Call 清除颜色

 

End If

 

If n = 2 Then

 

If x1 = 0 Or x2 = 0 Or Cells(x1, y1) = "" Or Cells(x2, y2) = "" Then MsgBox "请选择成员": Exit Sub

 

If y2 = 1 Then Call yd(x1, x2, 1): Call 清除颜色

 

If y2 = 4 Then Call yd(x1, x2, -1): Call 清除颜色

 

End If

 

Call 初始

 

If fx = 1 Then

 

fx = -1: ScrollArea = "$D1:$D7": t = "请从 B 岸选择成员"

 

Else

 

fx = 1: ScrollArea = "$A1:$A7": t = "请从 A 岸选择成员"

 

End If

 

Range("a10") = t

 

'判断是否失败

 

mr1 = WorksheetFunction.CountIf(Range("a2:a7"), "人")

 

mg1 = WorksheetFunction.CountIf(Range("a2:a7"), "鬼")

 

mr4 = WorksheetFunction.CountIf(Range("d2:d7"), "人")

 

mg4 = WorksheetFunction.CountIf(Range("d2:d7"), "鬼")

 

If (mr1 <> 0 And mr1 < mg1) Or (mr4 <> 0 And mr4 < mg4) Then MsgBox "失败了，重新开始", , "提示": Call 重新开始

 

If mr4 = 3 And mg4 = 3 Then MsgBox "恭喜你胜利了", , "提示": Call 重新开始

 

ActiveSheet.Protect '保护

 

End Sub

 

Private Sub yd(x1, x2, fx)

 

If fx = 1 Then

 

y = 1

 

For i = 1 To 3

 

Cells(x1, y + 1) = Cells(x1, y): Cells(x1, y) = ""

 

Cells(x2, y + 1) = Cells(x2, y): Cells(x2, y) = ""

 

y = y + 1: Call 延时

 

Next

 

Else

 

y = 4

 

For i = 1 To 3

 

Cells(x1, y - 1) = Cells(x1, y): Cells(x1, y) = ""

 

Cells(x2, y - 1) = Cells(x2, y): Cells(x2, y) = ""

 

y = y - 1: Call 延时

 

Next

 

End If

 

End Sub

 

Private Sub 延时()

 

For i = 1 To 50000000: Next

 

End Sub

 

Sub 重新开始()

 

ActiveSheet.Unprotect '撤消保护

 

Sheets("手动").Select

 

q = 0: Range("b9") = "" '清空步数

 

Range("a1") = "A岸": Range("b1") = "河": Range("d1") = "B岸"

 

Range("a2:a4") = "人": Range("a5:a7") = "鬼": Range("b2:d7") = ""

 

fx = 1 '方向

 

ScrollArea = "$A1:$A7"

 

Range("a10") = "重新开始，请从 A 岸选择成员"

 

Call 初始

 

ActiveSheet.Protect '保护

 

End Sub

 

8、给按钮指定宏

用鼠标右键选中上面添加的“初始化”按钮，从弹出的快捷菜单中选“指定宏”，在弹出的宏窗口中选择“重新开始”宏，确定。

用鼠标右键选中上面添加的“过河”按钮，从弹出的快捷菜单中选“指定宏”，在弹出的宏窗口中选择“过河”宏，确定。

9、完成

这样就完成了，可以开始游戏了。

回到EXCEL窗口，先用鼠标点击“初始化”按钮，再用鼠标选择一至两个过河成员后，按“过河”按钮就可以游戏了。

 

在游戏过程中如果失败或胜利会有提示。