Keypress to run a macro whilst on DoEvents

Zygorf

New Member
Joined
Apr 27, 2004
Messages
2
I currently have a little excel snake game made which uses a variable called 'direction' which can have the value left, right, up or down to determine direction the code below shows basically how the code presently works:

Code:
Sub snake()
start:
if direction = "left"
'move left
end if
if direction = "right"
'move right
end if
if direction = "up"
'move up
end if
if direction = "down"
'move down
end if
'wait for x seconds
doevents
goto start
End sub

'the below is repeated for left, right. up, down
Sub left()
 direction = "left"
End sub

The macro "left" is assigned to a command button which when pressed obviously changes direction variable, this works fine. Is there any way to do this on a keypress of the left arrow. unfortunately as I have seen from searching there appears to be no way to get an onkey command to run during a DoEvents break.
 

Excel Facts

Format cells as currency
Select range and press Ctrl+Shift+4 to format cells as currency. (Shift 4 is the $ sign).
DoEvents in itself does not create a delay. You will see that I have used Sleep here to stop things happening too fast. I guess that as you add more code - which will slow things down - the onetenth second delay can be reduced. You will also see that I have had to use it more than once with NT4/XL97.

To register keypresses we have to use an API call. Here is some experimental code I have written. Using API gave rise to strange behaviour here. This is why I have used a named cell range instead of ActiveCell. The Delete key is used to end the macro, but obviously you can use any other.

Things might be different with your setup.

Code:
'------------------------------------------------
'- Keypress Up/Down/Left/Right gaming experiment
'- moves selection & colours cells to show path taken.
'- Brian Baulsom October 2004
'------------------------------------------------
Declare Function GetKeyState Lib "user32" _
    (ByVal nVirtKey As Long) As Integer
'-----------------------------------------------
Const MePressed = &H1000
Dim Direction As String
Dim BackGround As Boolean
'- cell position
Dim rw As Long
Dim cl As Integer
Dim Here As Range
'-------------------------------------------------

Sub aKeyLoop()
    '- initialise
    BackGround = False
    rw = 1
    cl = 1
    ActiveSheet.Range("A1:Z37").Interior.ColorIndex = xlNone
    Set Here = ActiveSheet.Range("A1")
    Here.Select
    '-------------------------------------------------------
    '- Press Delete key to end loop
    While (GetKeyState(vbKeyDelete) And MePressed) = False
        '- check keys
        If GetKeyState(vbKeyLeft) And MePressed Then
            Direction = "Left"
            If cl > 1 Then cl = cl - 1
        ElseIf GetKeyState(vbKeyRight) And MePressed Then
            Direction = "Right"
            If cl < 26 Then cl = cl + 1
        ElseIf GetKeyState(vbKeyUp) And MePressed Then
            Direction = "Up"
            If rw > 1 Then rw = rw - 1
        ElseIf GetKeyState(vbKeyDown) And MePressed Then
            Direction = "Down"
            If rw < 37 Then rw = rw + 1
        Else
            Direction = "None"
        End If
        DoEvents
        '------------------------------------------------
        If Direction = "None" Then
            '- see loop is working
            BackGround = Not BackGround
            Here.Interior.ColorIndex = _
                             IIf(BackGround, 50, xlNone)
        Else
            '- move
            Here.Interior.ColorIndex = 50
            Set Here = _
               ActiveSheet.Range(Cells(rw, cl), Cells(rw, cl))
            Here.Select
        End If
        DoEvents
        '------------------------------------------------
        '- end loop
        Sleep 100       ' delay 1/10 second
        '-------------------------------------------------
    Wend
    '- exit
    MsgBox ("Finished.")
End Sub
 
Upvote 0
Sorry - you need this declaration to have it work :-
Code:
Public Declare Sub Sleep Lib "kernel32" _
(ByVal dwMilliseconds As Long)
 
Upvote 0

Forum statistics

Threads
1,222,737
Messages
6,167,903
Members
452,155
Latest member
Prakash K

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top