基于Excel VBA创建两款迷宫游戏的技术求助

一、基础准备 #

• 打开Excel新建工作表，选中所有单元格，设置列宽为3、行高为15（可按需调整），让单元格呈现正方形格子形态。
• 手动绘制迷宫：用填充色区分格子——灰色为不可通行的墙，白色为可通行路径，绿色标记左上角起点，红色标记右下角终点。
• 按Alt+F11打开VBA编辑器，后续代码均在此环境编写。

二、第一款：单角色逃脱迷宫 #

核心实现步骤 #

1. 角色初始化
   • 准备透明背景的像素人头PNG图片，插入工作表后右键命名为Player，调整图片大小适配单元格，将初始位置设为左上角起点单元格（如Cells(1,1)）。
2. 监听方向键移动
   • 在对应工作表对象（如Sheet1）中写入Worksheet_KeyDown事件代码，监听上（KeyCode=38）、下（40）、左（37）、右（39）方向键：

     Private Sub Worksheet_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
         Dim playerRow As Integer, playerCol As Integer
         ' 获取当前角色所在单元格坐标
         playerRow = Shapes("Player").TopLeftCell.Row
         playerCol = Shapes("Player").TopLeftCell.Column
         
         ' 根据方向键计算目标位置
         Select Case KeyCode
             Case 38: playerRow = playerRow - 1 ' 上移
             Case 40: playerRow = playerRow + 1 ' 下移
             Case 37: playerCol = playerCol - 1 ' 左移
             Case 39: playerCol = playerCol + 1 ' 右移
         End Select
         
         ' 判断目标位置是否可通行（非灰色墙）
         If Cells(playerRow, playerCol).Interior.ColorIndex <> 15 Then
             ' 移动角色到目标单元格
             With Shapes("Player")
                 .Top = Cells(playerRow, playerCol).Top
                 .Left = Cells(playerRow, playerCol).Left
             End With
             
             ' 判断是否到达终点
             If playerRow = Cells(Rows.Count, Columns.Count).Row And playerCol = Cells(Rows.Count, Columns.Count).Column Then
                 MsgBox "成功逃脱！"
                 ' 重置角色到起点
                 With Shapes("Player")
                     .Top = Cells(1, 1).Top
                     .Left = Cells(1, 1).Left
                 End With
             End If
         End If
     End Sub
     

3. 注意事项
   • 确保工作表EnableEvents属性为True（可在模块中执行Sheet1.EnableEvents = True），否则方向键事件无法触发。

三、第二款：带追踪怪物的迷宫 #

在第一款基础上新增功能 #

1. 怪物初始化
   • 插入透明背景的怪物头PNG图片，命名为Monster，设置初始位置为迷宫中间的路径单元格（避免与角色初始位置重合）。
2. 怪物追踪逻辑（曼哈顿距离定向移动）
   • 在模块中编写通用子程序MonsterMove，实现怪物向角色方向紧密追踪：

     Sub MonsterMove()
         Dim playerRow As Integer, playerCol As Integer
         Dim monsterRow As Integer, monsterCol As Integer
         
         ' 获取角色与怪物的当前位置
         playerRow = Shapes("Player").TopLeftCell.Row
         playerCol = Shapes("Player").TopLeftCell.Column
         monsterRow = Shapes("Monster").TopLeftCell.Row
         monsterCol = Shapes("Monster").TopLeftCell.Column
         
         ' 优先缩小与角色的横向或纵向距离
         If Abs(playerRow - monsterRow) > Abs(playerCol - monsterCol) Then
             ' 纵向距离更远，优先上下移动
             If playerRow > monsterRow And Cells(monsterRow + 1, monsterCol).Interior.ColorIndex <> 15 Then
                 monsterRow = monsterRow + 1
             ElseIf playerRow < monsterRow And Cells(monsterRow - 1, monsterCol).Interior.ColorIndex <> 15 Then
                 monsterRow = monsterRow - 1
             Else
                 ' 纵向不可移动，尝试横向移动
                 If playerCol > monsterCol And Cells(monsterRow, monsterCol + 1).Interior.ColorIndex <> 15 Then
                     monsterCol = monsterCol + 1
                 ElseIf playerCol < monsterCol And Cells(monsterRow, monsterCol - 1).Interior.ColorIndex <> 15 Then
                     monsterCol = monsterCol - 1
                 End If
             End If
         Else
             ' 横向距离更远，优先左右移动
             If playerCol > monsterCol And Cells(monsterRow, monsterCol + 1).Interior.ColorIndex <> 15 Then
                 monsterCol = monsterCol + 1
             ElseIf playerCol < monsterCol And Cells(monsterRow, monsterCol - 1).Interior.ColorIndex <> 15 Then
                 monsterCol = monsterCol - 1
             Else
                 ' 横向不可移动，尝试纵向移动
                 If playerRow > monsterRow And Cells(monsterRow + 1, monsterCol).Interior.ColorIndex <> 15 Then
                     monsterRow = monsterRow + 1
                 ElseIf playerRow < monsterRow And Cells(monsterRow - 1, monsterCol).Interior.ColorIndex <> 15 Then
                     monsterRow = monsterRow - 1
                 End If
             End If
         End If
         
         ' 移动怪物到目标位置
         With Shapes("Monster")
             .Top = Cells(monsterRow, monsterCol).Top
             .Left = Cells(monsterRow, monsterCol).Left
         End With
         
         ' 判断是否抓住角色
         If monsterRow = playerRow And monsterCol = playerCol Then
             MsgBox "被怪物抓住了！"
             ' 重置角色与怪物位置
             With Shapes("Player")
                 .Top = Cells(1, 1).Top
                 .Left = Cells(1, 1).Left
             End With
             With Shapes("Monster")
                 .Top = Cells(5, 5).Top ' 可自定义初始位置
                 .Left = Cells(5, 5).Left
             End With
         End If
     End Sub
     

3. 触发怪物移动
   • 修改第一款的Worksheet_KeyDown事件，在角色移动代码后添加Call MonsterMove，实现角色移动后怪物立即追踪。

四、图标配置细节 #

• 优先使用PNG格式图片（背景透明），插入后右键选择「大小和属性」，设置「随单元格改变位置和大小」，确保角色/怪物与单元格对齐。
• 更换图标时，直接替换工作表中对应名称的图片即可，无需修改代码。

五、VBA入门关键提示 #

• 通用子程序（如MonsterMove）放在「模块」中，事件代码（如Worksheet_KeyDown）放在对应工作表对象中。
• 按F8可逐行执行代码，查看变量值排查错误。
• 可通过Cells(r,c).Interior.ColorIndex获取单元格填充色索引，提前记录墙、路径等的索引值，避免判断错误。

内容的提问来源于stack exchange，提问作者Bjorn Starkiller