Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
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
Sub Snake()
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
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
Dim Groesse As Integer
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
End Sub
Sub Rechts()
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
Sleep 100
DoEvents
If Wand = True Then
Exit Sub
End If
If Selection.Borders(xlEdgeLeft).Weight = xlMedium Or Wand = True Then
MsgBox ("Verloren")
Wand = True
Exit Sub
End If
Loop While 0 = 0
End Sub
Sub 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(0, -1).Select
Selection.Interior.Color = 5287936
Laenge(4) = ActiveCell.Address
Sleep 100
DoEvents
If Wand = True Then
Exit Sub
End If
If Selection.Borders(xlEdgeRight).Weight = xlMedium Then
MsgBox ("Verloren")
Wand = True
Exit Sub
End If
Loop While 0 = 0
End Sub
Sub 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(-1, 0).Select
Selection.Interior.Color = 5287936
Laenge(4) = ActiveCell.Address
Sleep 100
DoEvents
If Wand = True Then
Exit Sub
End If
If Selection.Borders(xlEdgeBottom).Weight = xlMedium Or Wand = True Then
MsgBox ("Verloren")
Wand = True
Exit Sub
End If
Loop While 0 = 0
End Sub
Sub Runter()
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
Sleep 100
DoEvents
If Wand = True Then
Exit Sub
End If
If Selection.Borders(xlEdgeTop).Weight = xlMedium Or Wand = True Then
MsgBox ("Verloren")
Wand = True
Exit Sub
End If
Loop While 0 = 0
End Sub