上級26コード

 #If  VBA7 Then
Private Declare PtrSafe Sub Sleep Lib "kernel32" (ByVal ms As LongPtr) #Else 
Private Declare Sub Sleep Lib "kernel32" (ByVal ms As Long) #End  If
Private Declare PtrSafe Function GetAsyncKeyState Lib "User32.dll" (ByVal vKey As Long) As Long
Public flag As Boolean
Private xy(0 To 1)
Sub keyInput()
   
   If GetAsyncKeyState(vbKeyLeft) Then
   
       Call my_move(-1, 0)
       
   ElseIf GetAsyncKeyState(vbKeyRight) Then
   
       Call my_move(1, 0)
       
   ElseIf GetAsyncKeyState(vbKeyUp) Then
   
       Call my_move(0, -1)
       
   ElseIf GetAsyncKeyState(vbKeyDown) Then
   
       Call my_move(0, 1)
       
   End If
End Sub
Sub my_move(x, y)
   
   Dim r As Range
   
   Set r = Range(Cells(xy(1) + y, xy(0) + x), Cells(xy(1) + y, xy(0) + x))
   If r.Interior.Color <> RGB(0, 0, 0) Then
       Cells(xy(1), xy(0)) = ""
       xy(0) = xy(0) + x
       xy(1) = xy(1) + y
   End If
End Sub
Sub game()
   Dim c As Long
   
   Range("L2").Select
   
   xy(0) = 2
   xy(1) = 2
   
   Do While flag
       
       Cells(xy(1), xy(0)) = "◎"
       
       
       Sleep 50
       DoEvents
       
       Call keyInput
       
       Range("L2").Select
       
       c = c + 1
       
   Loop
   
   Range("A1:K11") = ""
End Sub
Private Sub CommandButton1_Click()
   
   If flag Then 'ストップ処理
       flag = False
       CommandButton1.Caption = "スタート"
       
   Else         'スタート処理
       flag = True
       CommandButton1.Caption = "ストップ"
       Call game
       
   End If
End Sub

この記事が気に入ったらサポートをしてみませんか?