汽車ぽっぽゲームを作りました

先週の木曜日、エクセルのマクロで、「汽車ぽっぽゲーム」を作りました。エクセルの画面一面に「┼」や「─」や「└」と言うものが出て、その線路を「汽車」が走って来るというゲームです。以下にコードをはりつけますね。

Option Explicit

Declare PtrSafe Function GetAsyncKeyState Lib "User32.dll" (ByVal vKey As Long) As Integer

Sub 汽車ぽっぽ()

    Dim rc As Integer

    Dim rcend As String

    Dim tuyosamoji, ironomoji As String

    Dim tuyosa, irobangou As Integer

    Dim gyou, retu, i, j, n As Integer

    Dim sentaku As String

    Dim px As Variant

    Dim hayasa, hayasas As Integer

    Dim ii As Integer

    Dim k As Integer

    Dim maegyou, maeretu, kishagyou, kisharetu, saishonoichi As Integer

    Dim kuurangyou, kuuranretu As Integer

    Dim hayaokuri As Integer

    Dim machijikan As Integer

    Dim PressNumber(5) As Integer

    Dim iro(3) As Integer

    'タテヨコを定める

    Cells.Clear

    gyou = 20

    retu = 20

    rc = MsgBox("ルールの説明を読みますか？", vbYesNo)

    If rc = vbYes Then

        MsgBox "汽車ぽっぽが左上のセルからスタートします。汽車には色がつけられています。" & gyou & "×" & retu & "の範囲に線路が広がっています。" _

          & "1箇所だけ穴があいています｡→を押すと穴の左のマスが右に移動します｡↑を押すと穴の下のマスが上に移動します｡←や↓を押しても同様です｡" _

          & "汽車ぽっぽはしばらく待ったのち、線路にそって走り出します。一番右下のセルがゴールです。脱線したらゲームオーバーです。" _

          & "早送りをしたいときはCtrlキーを押してください。" _

          & "ルールの説明は以上です｡よろしかったでしょうか｡ "

    End If

L2:

    ironomoji = InputBox("汽車の色を定めてください。1.黄色。2.赤。3.灰色。4.緑。5.靑。6.紫。7.水色。")

    irobangou = Int(Val(ironomoji))

    Select Case irobangou

        Case 1

            iro(1) = 252

            iro(2) = 212

            iro(3) = 27

        Case 2

            iro(1) = 215

            iro(2) = 29

            iro(3) = 59

        Case 3

            iro(1) = 100

            iro(2) = 103

            iro(3) = 102

        Case 4

            iro(1) = 59

            iro(2) = 175

            iro(3) = 117

        Case 5

            iro(1) = 0

            iro(2) = 115

            iro(3) = 176

        Case 6

            iro(1) = 146

            iro(2) = 141

            iro(3) = 185

        Case 7

            iro(1) = 172

            iro(2) = 219

            iro(3) = 218

        Case Else

            GoTo L2

    End Select

    '早送りしたときの速さ

    hayaokuri = 10

    Do

    'セルをクリアする

    Cells.Clear

    n = 0

    'セルを正方形にする

    px = 20 '正方形の一辺の長さ[px]

    ' セルの高さと幅を設定

    Cells.ColumnWidth = px * 0.118

    Cells.RowHeight = px * 0.75

    '速さを定める。１秒間に１回が100で、２回が50

    '速さと待ち時間（強さ）を定める

L1:

    tuyosamoji = InputBox("強さを定めてください。1.弱い。2.少し弱い。3.普通。4.少し強い。5.強い。")

    tuyosa = Int(Val(tuyosamoji))

    If tuyosa < 1 Or tuyosa > 5 Then GoTo L1

    Select Case tuyosa

        Case 1

            hayasa = 800

            machijikan = 6000

        Case 2

            hayasa = 400

            machijikan = 3000

        Case 3

            hayasa = 200

            machijikan = 2000

        Case 4

            hayasa = 100

            machijikan = 1000

        Case 5

            hayasa = 70

            machijikan = 700

    End Select

 ' hayasa = 400

    hayasas = 0

    '汽車の位置を定める、とくに前の位置

    'セルの色を初期化する。

    Range(Cells(1, 1), Cells(gyou, retu)).Interior.Color = RGB(255, 255, 255)

    'セルの罫線を定める。

    For i = 1 To gyou

        For j = 1 To retu

            If i = 1 And j = 1 Then

                saishonoichi = Int(Rnd * 2)

                If saishonoichi = 0 Then

                    maegyou = 1

                    maeretu = 0

                    kishagyou = 1

                    kisharetu = 1

                    Cells(1, 1).Value = "─"

                Else

                    maegyou = 0

                    maeretu = 1

                    kishagyou = 1

                    kisharetu = 1

                    Cells(1, 1).Value = "│"

                End If

            Else

                saishonoichi = Int(Rnd * 8) + 1

                Select Case saishonoichi

                    Case 1

                        Cells(i, j).Value = "─"

                    Case 2

                        Cells(i, j).Value = "│"

                    Case 3

                        Cells(i, j).Value = "┼"

                    Case 4

                        Cells(i, j).Value = "┼"

                    Case 5

                        Cells(i, j).Value = "└"

                    Case 6

                        Cells(i, j).Value = "┘"

                    Case 7

                        Cells(i, j).Value = "┐"

                    Case 8

                        Cells(i, j).Value = "┌"

                End Select

            End If

        Next

    Next

    '空欄をアクティブセルで定める。

    kuurangyou = Int(Rnd * (gyou - 1)) + 2

    kuuranretu = Int(Rnd * (retu - 1)) + 2

    Cells(kuurangyou, kuuranretu).Select

    ActiveCell.Value = ""

    'ゲームのスタート

' MsgBox "ゲームをスタートしましょう"

    For k = 1 To 5

        PressNumber(k) = 0

    Next

    '待ち時間の定義

' machijikan = 3000

    '色の定義

' iro(1) = 255

' iro(2) = 0

' iro(3) = 255

    'スタート。まず待たせる

'デバッグ用

' n = 1

' For ii = 1 To 5

' Cells(10 - ii, 10).Value = "│"

' Next

' maegyou = 9

' maeretu = 10

' kishagyou = 8

' kisharetu = 10

'デバッグ用終わり

    Range("A1").Interior.Color = RGB(iro(1), iro(2), iro(3))

    For i = 1 To machijikan

        Application.Wait [Now()] + 0.01 / 86400

        If PressUp = True Then

            PressNumber(1) = 1

        End If

        If PressDown = True Then

            PressNumber(2) = 1

        End If

        If PressLeft = True Then

            PressNumber(3) = 1

        End If

        If PressRight = True Then

            PressNumber(4) = 1

        End If

        If PressCtrl = True Then

            PressNumber(5) = 1

        End If

        If PressNumber(1) = 1 Then

            If ActiveCell.Row < gyou Then

                sentaku = ActiveCell.Offset(1, 0).Value

                ActiveCell.Offset(1, 0).Value = ""

                ActiveCell.Value = sentaku

                ActiveCell.Offset(1, 0).Select

            End If

            PressNumber(1) = 0

        End If

        If PressNumber(2) = 1 Then

            If ActiveCell.Row > 1 Then

                sentaku = ActiveCell.Offset(-1, 0).Value

                ActiveCell.Offset(-1, 0).Value = ""

                ActiveCell.Value = sentaku

                ActiveCell.Offset(-1, 0).Select

            End If

            PressNumber(2) = 0

        End If

        If PressNumber(3) = 1 Then

            If ActiveCell.Column < retu Then

                sentaku = ActiveCell.Offset(0, 1).Value

                ActiveCell.Offset(0, 1).Value = ""

                ActiveCell.Value = sentaku

                ActiveCell.Offset(0, 1).Select

            End If

            PressNumber(3) = 0

        End If

        If PressNumber(4) = 1 Then

            If ActiveCell.Column > 1 Then

                sentaku = ActiveCell.Offset(0, -1).Value

                ActiveCell.Offset(0, -1).Value = ""

                ActiveCell.Value = sentaku

                ActiveCell.Offset(0, -1).Select

            End If

            PressNumber(4) = 0

        End If

        If PressNumber(5) = 1 Then

            hayasa = hayaokuri

            PressNumber(5) = 0

            Exit For

        End If

' For k = 1 To 5

' PressNumber(k) = 0

' Next

    Next

'　動き出してから

    Do While maegyou <> gyou Or maeretu <> retu

        For i = 1 To hayasa

            Application.Wait [Now()] + 0.01 / 86400

            If PressUp = True Then

                PressNumber(1) = 1

            End If

            If PressDown = True Then

                PressNumber(2) = 1

            End If

            If PressLeft = True Then

                PressNumber(3) = 1

            End If

            If PressRight = True Then

                PressNumber(4) = 1

            End If

            If PressCtrl = True Then

                PressNumber(5) = 1

            End If

            If PressNumber(1) = 1 Then

                If ActiveCell.Row < gyou Then

                    sentaku = ActiveCell.Offset(1, 0).Value

                    ActiveCell.Offset(1, 0).Value = ""

                    ActiveCell.Value = sentaku

                    ActiveCell.Offset(1, 0).Select

                End If

                PressNumber(1) = 0

            End If

            If PressNumber(2) = 1 Then

                If ActiveCell.Row > 1 Then

                    sentaku = ActiveCell.Offset(-1, 0).Value

                    ActiveCell.Offset(-1, 0).Value = ""

                    ActiveCell.Value = sentaku

                    ActiveCell.Offset(-1, 0).Select

                End If

                PressNumber(2) = 0

            End If

            If PressNumber(3) = 1 Then

                If ActiveCell.Column < retu Then

                    sentaku = ActiveCell.Offset(0, 1).Value

                    ActiveCell.Offset(0, 1).Value = ""

                    ActiveCell.Value = sentaku

                    ActiveCell.Offset(0, 1).Select

                End If

                PressNumber(3) = 0

            End If

            If PressNumber(4) = 1 Then

                If ActiveCell.Column > 1 Then

                    sentaku = ActiveCell.Offset(0, -1).Value

                    ActiveCell.Offset(0, -1).Value = ""

                    ActiveCell.Value = sentaku

                    ActiveCell.Offset(0, -1).Select

                End If

                PressNumber(4) = 0

            End If

            If PressNumber(5) = 1 Then

                hayasas = 1

                PressNumber(5) = 0

            End If

            If hayasas = 1 Then

                hayasa = hayaokuri

                hayasas = 0

                Exit For

            End If

        Next

'汽車が進む

     If n = 1 Then

            Range(Cells(maegyou, maeretu), Cells(maegyou, maeretu)).Interior.Color = RGB(255, 255, 255)

        End If

        If kishagyou > gyou Or kisharetu > retu Or kishagyou < 1 Or kisharetu < 1 Then

            MsgBox "ゲームオーバーです"

            Exit Do

        End If

' Cells(1, 41).Value = maegyou

' Cells(1, 42).Value = maeretu

' Cells(2, 41).Value = kishagyou

' Cells(2, 42).Value = kisharetu

        n = 1

        If Cells(kishagyou, kisharetu).Value = "│" Then

            If maeretu = kisharetu Then

                If maegyou = kishagyou - 1 Then

                    maegyou = kishagyou

                    kishagyou = kishagyou + 1

                ElseIf maegyou = kishagyou + 1 Then

                    maegyou = kishagyou

                    kishagyou = kishagyou - 1

                Else

                    MsgBox "ゲームオーバーです"

                    Exit Do

                End If

            Else

                MsgBox "ゲームオーバーです"

                Exit Do

            End If

        ElseIf Cells(kishagyou, kisharetu).Value = "─" Then

            If maegyou = kishagyou Then

                If maeretu = kisharetu - 1 Then

                    maeretu = kisharetu

                    kisharetu = kisharetu + 1

                ElseIf maeretu = kisharetu + 1 Then

                    maeretu = kisharetu

                    kisharetu = kisharetu - 1

                Else

                    MsgBox "ゲームオーバーです"

                    Exit Do

                End If

            Else

                MsgBox "ゲームオーバーです"

                Exit Do

            End If

        ElseIf Cells(kishagyou, kisharetu).Value = "┼" Then

             If maeretu = kisharetu Then

                If maegyou = kishagyou - 1 Then

                    maegyou = kishagyou

                    kishagyou = kishagyou + 1

                ElseIf maegyou = kishagyou + 1 Then

                    maegyou = kishagyou

                    kishagyou = kishagyou - 1

                End If

             ElseIf maegyou = kishagyou Then

                If maeretu = kisharetu - 1 Then

                    maeretu = kisharetu

                    kisharetu = kisharetu + 1

                ElseIf maeretu = kisharetu + 1 Then

                    maeretu = kisharetu

                    kisharetu = kisharetu - 1

                End If

             Else

                MsgBox "ゲームオーバーです"

                Exit Do

             End If

        ElseIf Cells(kishagyou, kisharetu).Value = "└" Then

            If maeretu = kisharetu And maegyou = kishagyou - 1 Then

                maegyou = kishagyou

                kisharetu = kisharetu + 1

            ElseIf maegyou = kishagyou And maeretu = kisharetu + 1 Then

                maeretu = kisharetu

                kishagyou = kishagyou - 1

            Else

                MsgBox "ゲームオーバーです"

                Exit Do

             End If

        ElseIf Cells(kishagyou, kisharetu).Value = "┘" Then

            If maeretu = kisharetu And maegyou = kishagyou - 1 Then

                maegyou = kishagyou

                kisharetu = kisharetu - 1

            ElseIf maegyou = kishagyou And maeretu = kisharetu - 1 Then

                maeretu = kisharetu

                kishagyou = kishagyou - 1

             Else

                MsgBox "ゲームオーバーです"

                Exit Do

             End If

        ElseIf Cells(kishagyou, kisharetu).Value = "┐" Then

            If maeretu = kisharetu And maegyou = kishagyou + 1 Then

                maegyou = kishagyou

                kisharetu = kisharetu - 1

            ElseIf maegyou = kishagyou And maeretu = kisharetu - 1 Then

                maeretu = kisharetu

                kishagyou = kishagyou + 1

            Else

                MsgBox "ゲームオーバーです"

                Exit Do

            End If

        ElseIf Cells(kishagyou, kisharetu).Value = "┌" Then

            If maeretu = kisharetu And maegyou = kishagyou + 1 Then

                maegyou = kishagyou

                kisharetu = kisharetu + 1

            ElseIf maegyou = kishagyou And maeretu = kisharetu + 1 Then

                maeretu = kisharetu

                kishagyou = kishagyou + 1

            Else

                MsgBox "ゲームオーバーです"

                Exit Do

            End If

        Else

            MsgBox "ゲームオーバーです"

            Exit Do

        End If

        If maegyou > gyou Or maeretu > retu Or maegyou < 1 Or maeretu < 1 Then

            MsgBox "ゲームオーバーです"

            Exit Do

        End If

        Range(Cells(maegyou, maeretu), Cells(maegyou, maeretu)).Interior.Color = RGB(iro(1), iro(2), iro(3))

Loop

If maegyou = gyou And maeretu = retu Then

    MsgBox "おめでとうございます"

End If

    rc = MsgBox("ゲームを続けますか？", vbYesNo)

    If rc = vbNo Then

        rcend = InputBox("本当にやめる場合はendと入力してください")

        If rcend = "end" Then

            Exit Do

        End If

    End If

Loop

MsgBox "遊んでくださりありがとうございました。"

End Sub

Function PressCtrl() As Boolean

    Const KEY_PRESSED = -32767

    PressCtrl = (GetAsyncKeyState(vbKeyControl) And KEY_PRESSED) = KEY_PRESSED

End Function

Function PressZ() As Boolean

    Const KEY_PRESSED = -32767

    PressZ = (GetAsyncKeyState(vbKeyZ) And KEY_PRESSED) = KEY_PRESSED

End Function

Function PressX() As Boolean

    Const KEY_PRESSED = -32767

    PressX = (GetAsyncKeyState(vbKeyX) And KEY_PRESSED) = KEY_PRESSED

End Function

Function PressC() As Boolean

    Const KEY_PRESSED = -32767

    PressC = (GetAsyncKeyState(vbKeyC) And KEY_PRESSED) = KEY_PRESSED

End Function

Function PressV() As Boolean

    Const KEY_PRESSED = -32767

    PressV = (GetAsyncKeyState(vbKeyV) And KEY_PRESSED) = KEY_PRESSED

End Function

Function PressLeft() As Boolean

    Const KEY_PRESSED = -32767

    PressLeft = (GetAsyncKeyState(vbKeyLeft) And KEY_PRESSED) = KEY_PRESSED

End Function

Function PressRight() As Boolean

    Const KEY_PRESSED = -32767

    PressRight = (GetAsyncKeyState(vbKeyRight) And KEY_PRESSED) = KEY_PRESSED

End Function

Function PressUp() As Boolean

    Const KEY_PRESSED = -32767

    PressUp = (GetAsyncKeyState(vbKeyUp) And KEY_PRESSED) = KEY_PRESSED

End Function

Function PressDown() As Boolean

    Const KEY_PRESSED = -32767

    PressDown = (GetAsyncKeyState(vbKeyDown) And KEY_PRESSED) = KEY_PRESSED

End Function