Question

我的宏导致excel崩溃到桌面而没有调试或错误消息，整个应用程序关闭，关闭任何打开的excel实例。

到目前为止我写的代码非常简单，所以我不知道导致崩溃的原因。

StartGame()完成后似乎发生了崩溃。我认为它是由定时器引起的，它每50ms运行一次Main（），因为CTD专门发生在StartGame()的End Sub之后。

我已经包含了以下所有代码。

主要模块

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

计时器模块

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

公开声明模块

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

类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

班级图形

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

班级广场

Option Explicit

Private SquareX As Integer
Private SquareY As Integer

Private Sub Class_Initialize()

    SquareX = BORDER_START_X
    SquareY = BORDER_START_Y

End Sub

对于大胖代码转储感到抱歉，但我真的不知道是什么导致了这个问题！

非常感谢任何帮助！

Answer 1

在调用DrawSquare（）时，CTD是由缺少的参数引起的。

我错误地错过了潜艇的x和y坐标。

通常，编译器会接收到这个错误，但是当我的计时器自动调用Main模块时，没有进行错误检查。

Public Declare Function SetTimer Lib "user32" (ByVal hwnd As Long, ByVal nIDEvent As Long, ByVal uElapse As Long, ByVal lpTimerFunc As Long) As Long

Excel VBA中的CTD

1 个答案: