excel如何冻结某一矩形区域（excel怎么把选中的区域冻结）

如果中心的坐标为(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函数，并将其拖入合适的位置：

excel如何冻结某一矩形区域,excel怎么把选中的区域冻结(9)

指定函数

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

我们运行一下，看看效果：

excel如何冻结某一矩形区域,excel怎么把选中的区域冻结(10)

好，测试结果显示完全没问题。

由于后期我们需要在表格最上方的固定位置不断随机生成新的方块，所以我们应该将此功能再次封装为一个独立函数，为了防止产生伪随机数，我们采用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

至此，方块功能方面已经完全实现，我们随机生成一个进行测试：

excel如何冻结某一矩形区域,excel怎么把选中的区域冻结(11)