Excel中通过VBA进行迷宫游戏

整体来说，算法优劣什么的没考虑过。当时就是想如果我用笔在纸上面画一个迷宫应该怎么画，然后代码就写出来了。可能整体的效率很低。

代码实现两个功能：

1、迷宫绘制：

Main函数就是干这个的。

2、迷宫游戏：

Reset函数用来进行一些初始设定（每次玩之前都要设定一下）；

其他的就是利用Excel的Worksheet_SelectionChange函数实现“走步”。

有兴趣的朋友可以拿来玩一玩，消磨时间。

具体的使用：

将整个代码拷贝到Sheet1的编辑框（因为Worksheet_SelectionChange函数的限制）。

然后再Sheet1中建立两个按钮：

第一个按钮名字改成“生成”，指向的宏设置为“Main”；

第二个按钮名字叫“开始”，制定的宏设置为“Reset”。

如果顺序错了可能不好用。VBA我也不是很明白，就是没事琢磨了一下，没有系统的学过。

然后，在“H2”的位置输入迷宫的大小，是一个5~250之间的数字。当然也可以适当的修饰一下。比如附图的形式：

附：代码

'  1--Up
'  0--Down
'  3--Left
'  2--Right

'  x--Row ; y--Column

'  本程序算法无所谓快慢，完全按着普通人思维方式完成

Dim  iMazeSize  As   Integer
Dim  iMaze( 251 ,  251 )  As  Variant
Dim  x, y, iGetRndRet, iPOrder, iNoWay  As   Integer
Dim  subx, suby  As   Integer
Dim  iStartLine  As   Integer
Dim  bInit  As   Boolean
Dim  bGoStart  As   Boolean
Dim  bDrawing  As   Boolean
Dim  CrtRow, CrtClm  As   Integer
Dim  BckRow, BckClm  As   Integer
Dim  iRowMax, iColumnMax  As   Integer
Dim  iStepCnt  As   Integer

Sub  Reset()
    bGoStart  =   Not  bGoStart
    
     If  (bGoStart)  Then
        ActiveSheet.Shapes( " Button 2 " ).Select
        Selection.Characters.Text  =   " 结束 "
        iStepCnt  =   0
        ActiveSheet.Cells( 3 ,  8 )  =  iStepCnt
        BckRow  =   6
        BckClm  =   2
        OutMazeColor  6 ,  2 ,  51
        Cells( 6 ,  2 ).Select
         For  i  =   7   To  ActiveSheet.UsedRange.Rows.Count
             For  j  =   5   To  ActiveSheet.UsedRange.Columns.Count
             If  (Cells(i, j).Interior.ColorIndex  =   15 )  Then
                iRowMax  =  i
                iColumnMax  =  j
             End   If
             Next
         Next
     Else
        ActiveSheet.Shapes( " Button 2 " ).Select
        Selection.Characters.Text  =   " 开始 "
     End   If


End Sub


Private   Sub  Worksheet_SelectionChange(ByVal Target  As  Range)
     If  ((bGoStart)  And  ( Not  bDrawing))  Then
        CrtRow  =  ActiveCell.Row
        CrtClm  =  ActiveCell.Column
         If   Not  (bInit)  Then
            BckRow  =   6
            BckClm  =   2
            bInit  =   True
         End   If
        
        OutMazeColor BckRow, BckClm,  2
         If  (( Abs (CrtRow  -  BckRow)  <=   1 )  And  ( Abs (CrtClm  -  BckClm)  <=   1 ))  Then
             If  (CrtRow  =  (iRowMax))  And  (CrtClm  =  (iColumnMax))  Then
                 MsgBox   " Succ! "
                bGoStart  =   False
                ActiveSheet.Shapes( " Button 2 " ).Select
                Selection.Characters.Text  =   " 开始 "
                OutMazeColor CrtRow, CrtClm,  51
                ActiveSheet.Cells(CrtRow, CrtClm).Select
             ElseIf  (Cells(CrtRow, CrtClm).Interior.ColorIndex  <>   2 )  Then
                CrtRow  =  BckRow
                CrtClm  =  BckClm
                OutMazeColor CrtRow, CrtClm,  51
                ActiveSheet.Cells(BckRow, BckClm).Select
             Else
                iStepCnt  =  iStepCnt  +   1
                ActiveSheet.Cells( 3 ,  8 )  =  iStepCnt
                OutMazeColor CrtRow, CrtClm,  51
                ActiveSheet.Cells(CrtRow, CrtClm).Select
             End   If
         Else
            CrtRow  =  BckRow
            CrtClm  =  BckClm
            OutMazeColor CrtRow, CrtClm,  51
            ActiveSheet.Cells(BckRow, BckClm).Select
         End   If
        
        BckRow  =  CrtRow
        BckClm  =  CrtClm
     End   If
End Sub