CTD in Excel VBA - excel

Question

My macro is causing excel to crash to desktop with no debug or error message, the whole application shuts down, closing any open instances of excel.
The code that I've written so far is pretty light, so I have no idea what is causing the crash.
The crash appears to occur after StartGame() has finished. I assume it's being caused by the Timer which runs Main() every 50ms as the CTD exclusively happens after End Sub in StartGame().
I've included all the code below.
Main Module
Option Explicit
Public Sub StartGame()
InitialiseGame
InitialiseTimer
GameRunning = True
End Sub
Public Sub Main()
If GameInput.TabIsPressed Then TerminateTimer
If Not GameRunning Then Exit Sub
Graphics.DrawSquare
End Sub
Private Sub InitialiseGame()
Set GameInput = New ClassGameInput
Set Graphics = New ClassGraphics
Set Square = New ClassSquare
End Sub
Timer Module
Option Explicit
Private Const MILLISECONDS_IN_SECOND As Integer = 1000
Private Const GAME_TICKS_PER_SECOND As Integer = 20
Private GameTimerID As Long
Public Sub InitialiseTimer()
Dim GameTimerInterval As Double
GameTimerInterval = MILLISECONDS_IN_SECOND / GAME_TICKS_PER_SECOND
Sleep (500)
GameTimerID = SetTimer(0, 0, GameTimerInterval, AddressOf Main)
End Sub
Public Sub TerminateTimer()
If GameTimerID <> 0 Then
KillTimer 0, GameTimerID
GameTimerID = 0
GameRunning = False
End If
Set GameInput = Nothing
Set Graphics = Nothing
Set Square = Nothing
End Sub
Public Declarations Module
Option Explicit
#If Win64 Then
Public Declare PtrSafe Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
Public Declare PtrSafe Function SetTimer Lib "user32" (ByVal hwnd As LongPtr, ByVal nIDEvent As LongPtr, ByVal uElapse As Long, ByVal lpTimerFunc As LongPtr) As LongPtr
Public Declare PtrSafe Function KillTimer Lib "user32" (ByVal hwnd As LongPtr, ByVal nIDEvent As LongPtr) As Long
Public Declare Function GetAsyncKeyState Lib "user32" (ByVal vKey As Long) As Integer
#Else
Public Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
Public Declare Function SetTimer Lib "user32" (ByVal hwnd As Long, ByVal nIDEvent As Long, ByVal uElapse As Long, ByVal lpTimerFunc As Long) As Long
Public Declare Function KillTimer Lib "user32" (ByVal hwnd As Long, ByVal nIDEvent As Long) As Long
Public Declare PtrSafe Function GetAsyncKeyState Lib "user32" (ByVal vKey As Long) As Integer
#End If
Public Const BORDER_START_X As Integer = 4
Public Const BORDER_START_Y As Integer = 4
Public Const BORDER_END_X As Integer = 185
Public Const BORDER_END_Y As Integer = 73
Public Const SQUARE_SIZE As Integer = 10
Public Const SQUARE_COLOUR As Long = rgbLightBlue
Public GameRunning As Boolean
Public GameInput As ClassGameInput
Public Graphics As ClassGraphics
Public Square As ClassSquare
Class GameInput
Option Explicit
Public Function UpIsPressed() As Boolean
UpIsPressed = (GetAsyncKeyState(vbKeyUp) <> 0)
End Function
Public Function DownIsPressed() As Boolean
DownIsPressed = (GetAsyncKeyState(vbKeyDown) <> 0)
End Function
Public Function LeftIsPressed() As Boolean
LeftIsPressed = (GetAsyncKeyState(vbKeyLeft) <> 0)
End Function
Public Function RightIsPressed() As Boolean
RightIsPressed = (GetAsyncKeyState(vbKeyRight) <> 0)
End Function
Public Function TabIsPressed() As Boolean
TabIsPressed = (GetAsyncKeyState(vbKeyTab) <> 0)
End Function
Class Graphics
Option Explicit
Const COL_WIDTH As Double = 0.83
Const ROW_HEIGHT As Double = 7.5
Private GameCanvas As Range
Private Sub Class_Initialize()
With shtGame
.cmdGo.Visible = False
.Cells.Columns.ColumnWidth = COL_WIDTH
.Cells.Rows.RowHeight = ROW_HEIGHT
.EnableSelection = xlNoSelection
.Protect AllowFormattingCells:=True
.Cells.Interior.Color = rgbDarkSlateGrey
Set GameCanvas = .Range(.Cells(BORDER_START_Y, BORDER_START_X), .Cells(BORDER_END_Y, BORDER_END_X))
GameCanvas.Interior.Pattern = xlNone
End With
End Sub
Public Sub DrawSquare(SquareX As Integer, SquareY As Integer)
Dim SquareRange As Range
With shtGame
Set SquareRange = .Range(.Cells(SquareY, SquareX), .Cells(SquareY + SQUARE_SIZE - 1, SquareX + SQUARE_SIZE - 1))
SquareRange.Interior.Color = SQUARE_COLOUR
End With
End Sub
Private Sub Class_Terminate()
With shtGame
.cmdGo.Visible = True
.EnableSelection = xlNoRestrictions
.Unprotect
.Cells.Clear
End With
End Sub
Class Square
Option Explicit
Private SquareX As Integer
Private SquareY As Integer
Private Sub Class_Initialize()
SquareX = BORDER_START_X
SquareY = BORDER_START_Y
End Sub
Sorry for the big fat code dump, but I really have no idea what is causing the problem!
Any help is greatly appreciated!

Answer 1

The CTD was being caused by missing arguments when calling DrawSquare().
I had incorrectly missed the x and y co-ordinates of the sub.
Normally, the compiler would pick-up on this error, however as the Main module was being called automatically by my timer no error checking was taking place.
Public Declare Function SetTimer Lib "user32" (ByVal hwnd As Long, ByVal nIDEvent As Long, ByVal uElapse As Long, ByVal lpTimerFunc As Long) As Long