Geht nicht...:S

Es kommt immer der Laufzeitfehler '28' Nicht genügend Stapelspeicher :S

Wenn ich auf Debuggen klicke wird mier der erst Unload Befehl gelb markiert...:S

Hab ich auch alles richtig gemacht ?

Dim Kopf_Zeile As Integer, Kopf_Spalte As Integer
Dim Letzte_Zeile As Integer, Letzte_Spalte As Integer
Dim Laenge() As String
Dim Wand As Boolean

Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)

    

Sub Snake()
'====================================================================
'Alles Löschen und Spaltenbreite und -höhe anpassen
'====================================================================

    Cells.Select
    Selection.ClearContents
    Range("A1").Select

    Cells.Select
    Selection.ClearFormats
    Range("A1").Select

    Cells.Select
    Selection.RowHeight = 12
    Selection.ColumnWidth = 2.5
    Range("A1").Select
    
'====================================================================
'Spielbereich festlegen
'====================================================================

    Range("J10:AM39").Select
    With Selection.Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .Weight = xlMedium
    End With
    With Selection.Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .Weight = xlMedium
    End With
    With Selection.Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .Weight = xlMedium
    End With
    With Selection.Borders(xlEdgeRight)
        .LineStyle = xlContinuous
        .Weight = xlMedium
    End With
'====================================================================
'Snake entstehen lassen
'====================================================================
    Dim Groesse As Integer, a As Boolean
    Wand = False
    Groesse = 5
    
    Range("V24:Z24").Select
    Selection.Interior.Color = 5287936
    
        ReDim Laenge(4)
        Laenge(0) = "V24"
        Laenge(1) = "W24"
        Laenge(2) = "X24"
        Laenge(3) = "Y24"
        Laenge(4) = "Z24"
    
    Range("V24").Select
    Letzte_Spalte = ActiveCell.Column
    Letzte_Zeile = ActiveCell.Row
    
    Range("Z24").Select
    Kopf_Spalte = ActiveCell.Column
    Kopf_Zeile = ActiveCell.Row
    
    Application.OnKey "{RIGHT}", "Rechts"
    Application.OnKey "{UP}", "Rauf"
    Application.OnKey "{DOWN}", "Runter"
    Application.OnKey "{LEFT}", "Links"
    
End Sub
Function Rechts()
    
    Unload Runter
    Unload Links
    Unload Rauf
        
    Dim j As Integer

        Do
            Range(Laenge(0)).Select
            
            Selection.Interior.Pattern = xlNone
            
            For j = 0 To (UBound(Laenge)) - 1
    
               Laenge(j) = Laenge(j + 1)
    
            Next j
            
            Range(Laenge(4)).Select
            ActiveCell.Offset(0, 1).Select
            Selection.Interior.Color = 5287936
            Laenge(4) = ActiveCell.Address
            Dim Start As Double
            Start = Timer
            While Timer < Start + 0.01
                DoEvents
            Wend

            If Wand = True Then
                Exit Function
            End If
            
            
            If Selection.Borders(xlEdgeLeft).Weight = xlMedium Or Wand = True Then
                MsgBox ("Verloren!!!!!!!")
                Wand = True
                Exit Function
            End If
        Loop While 0 = 0
    
End Function

Function Links()

    Unload Runter
    Unload Rechts
    Unload Rauf
    
    Dim j As Integer
        Do
            
            Range(Laenge(0)).Select
            Range(Laenge(0)).Select
            Selection.Interior.Pattern = xlNone
            
            For j = 0 To (UBound(Laenge)) - 1
    
               Laenge(j) = Laenge(j + 1)
    
            Next j
            
            Range(Laenge(4)).Select
            ActiveCell.Offset(0, -1).Select
            Selection.Interior.Color = 5287936
            Laenge(4) = ActiveCell.Address
            While Timer < Start + 0.01
                DoEvents
            Wend
            
            If Wand = True Then
                Exit Function
            End If
            
            If Selection.Borders(xlEdgeRight).Weight = xlMedium Then
                MsgBox ("Verloren!!!!!!!")
                Wand = True
                Exit Function
            End If
        Loop While 0 = 0
    
End Function

Function Rauf()

    Unload Runter
    Unload Rechts
    Unload Links
    
    Dim j As Integer
        Do
            
            Range(Laenge(0)).Select
            Selection.Interior.Pattern = xlNone
            
            For j = 0 To (UBound(Laenge)) - 1
    
               Laenge(j) = Laenge(j + 1)
    
            Next j
            
            Range(Laenge(4)).Select
            ActiveCell.Offset(-1, 0).Select
            Selection.Interior.Color = 5287936
            Laenge(4) = ActiveCell.Address
            While Timer < Start + 0.01
                DoEvents
            Wend
            
            If Wand = True Then
                Exit Function
            End If
            
            If Selection.Borders(xlEdgeBottom).Weight = xlMedium Or Wand = True Then
                MsgBox ("Verloren!!!!!!!")
                Wand = True
                Exit Function
            End If
        Loop While 0 = 0
End Function

Function Runter()

    Unload Rauf
    Unload Rechts
    Unload Links
    
    Dim j As Integer

        Do
            
            Range(Laenge(0)).Select
            Selection.Interior.Pattern = xlNone
            
            For j = 0 To (UBound(Laenge)) - 1
    
               Laenge(j) = Laenge(j + 1)
    
            Next j
            
            Range(Laenge(4)).Select
            ActiveCell.Offset(1, 0).Select
            Selection.Interior.Color = 5287936
            Laenge(4) = ActiveCell.Address
            While Timer < Start + 0.01
                DoEvents
            Wend
            
            If Wand = True Then
                Exit Function
            End If
            
            If Selection.Borders(xlEdgeTop).Weight = xlMedium Or Wand = True Then
                MsgBox ("Verloren!!!!!!!")
                Wand = True
                Exit Function
            End If
        Loop While 0 = 0
End Function

Gruss

Samse