Re5：50歳から始めるラズベリーパイ-7

Re5：50歳から始めるラズベリーパイ

簡単なゲームで学ぶVBAプログラミング入門

amazon kindle版を出版しました。

---

3.3　ブロックパズルの作成-3

'Worksheetのプログラムです。
'クリックされたセルの上下左右が空いている場合は移動します。一度に２つは移動しません。
'ブロックパズルの移動と判定
sub block_puzzle()

Dim c As Range
Dim x As Integer
Dim y As Integer

y = ActiveCell.Row
x = ActiveCell.Column

cells(5,1)=y
cells(5,2)=x

Call moveok(y, x)'移動できるかチェック

'上に移動
 If (m = 1) Then
     Cells(y - 1, x).Value = Cells(y, x).Value
     Cells(y, x).Value = ""
 End If
'右に移動
 If (m = 2) Then
     Cells(y, x + 1).Value = Cells(y, x).Value
     Cells(y, x).Value = ""
 End If
'下に移動
 If (m = 3) Then
     Cells(y + 1, x).Value = Cells(y, x).Value
     Cells(y, x).Value = ""
 End If
'左に移動
 If (m = 4) Then
     Cells(y, x - 1).Value = Cells(y, x).Value
     Cells(y, x).Value = ""
 End If

 For i = 0 To 2
   For ii = 0 To 2
     If (Cells(i + 1, ii + 1).Value >= 1 And Cells(i + 1, ii + 1).Value <= 3) Then
          Cells(i + 1, ii + 1).Interior.Color = RGB(0, 255, 0)
     ElseIf (Cells(i + 1, ii + 1).Value >= 4 And Cells(i + 1, ii + 1).Value <= 6) Then
          Cells(i + 1, ii + 1).Interior.Color = RGB(255, 255, 0)
     End If
     If (Cells(i + 1, ii + 1).Value >= 7 And Cells(i + 1, ii + 1).Value <= 9) Then
          Cells(i + 1, ii + 1).Interior.Color = RGB(255, 0, 0)
     End If
     If (Cells(i + 1, ii + 1).Value = "") Then
          Cells(i + 1, ii + 1).Interior.Color = RGB(255, 255, 255)
     End If
   Next ii
Next i

If (Cells(1, 1).Value = 1 And Cells(1, 2).Value = 2 And Cells(1, 3).Value = 3) Then
   If (Cells(2, 1).Value = 4 And Cells(2, 2).Value = 5 And Cells(2, 3).Value = 6) Then
     If (Cells(3, 1).Value = 7 And Cells(3, 2).Value = 8) Then
          Cells(4.1).Value="完成！！"
     End If
  End If
End If

end sub

Sub moveok(y As Integer, x As Integer)

m = 0
'もし空白をクリックしたら何もしない
If (Cells(y, x).Value <> "") Then
'0：何もしない、1：上、2：右、3：下、4：左
x1 = x
y1 = y - 1
x2 = x + 1
y2 = y
x3 = x
y3 = y + 1
x4 = x - 1
y4 = y

'上をチェック
 If (x1 >= 1 And x1 <= 3 And y1 >= 1 And y1 <= 3) Then
     If (Cells(y1, x1).Value = "") Then
          m = 1
     End If
 End If
'右をチェック
 If (x2 >= 1 And x2 <= 3 And y2 >= 1 And y2 <= 3) Then
     If (Cells(y2, x2).Value = "") Then
          m = 2
     End If
 End If
'下をチェック
 If (x3 >= 1 And x3 <= 3 And y3 >= 1 And y3 <= 3) Then
     If (Cells(y3, x3).Value = "") Then
          m = 3
     End If
 End If
'左をチェック
 If (x4 >= 1 And x4 <= 3 And y4 >= 1 And y4 <= 3) Then
     If (Cells(y4, x4).Value = "") Then
          m = 4
     End If
 End If

End If
End Sub