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
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
, Weg
As
Integer
Groesse = 5
Weg = 1
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
i
As
Integer
, Zufallszahl
As
Integer
, a
As
Boolean
, 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
Selection.Borders(xlEdgeLeft).Weight = xlMedium
Then
MsgBox (
"Verloren"
)
GoTo
G1
End
If
Loop
While
0 = 0
G1:
End
Sub
Sub
Links()
Dim
i
As
Integer
, Zufallszahl
As
Integer
, a
As
Boolean
, 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
Selection.Borders(xlEdgeRight).Weight = xlMedium
Then
MsgBox (
"Verloren"
)
GoTo
G2
End
If
Loop
While
0 = 0
G2:
End
Sub
Sub
Rauf()
Dim
i
As
Integer
, Zufallszahl
As
Integer
, a
As
Boolean
, 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
Selection.Borders(xlEdgeBottom).Weight = xlMedium
Then
MsgBox (
"Verloren"
)
GoTo
G3
End
If
Loop
While
0 = 0
G3:
End
Sub
Sub
Runter()
Dim
i
As
Integer
, Zufallszahl
As
Integer
, a
As
Boolean
, 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
Selection.Borders(xlEdgeTop).Weight = xlMedium
Then
MsgBox (
"Verloren"
)
GoTo
G4
End
If
Loop
While
0 = 0
G4:
End
Sub