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
Dim
Zufallszahl_1
As
Integer
, Zufallszahl_2
As
Integer
Dim
Toeszli_Adresse
As
String
Dim
Groesse
As
Integer
Dim
Weg
As
Integer
Sub
Snake()
Cells.
Select
Selection.ClearFormats
Range(
"A1"
).
Select
Cells.
Select
Selection.RowHeight = 12
Selection.ColumnWidth = 2.5
Range(
"AU:AU"
).ColumnWidth = 3.5
Range(
"AU30"
).Value = 0
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
, a
As
Boolean
, Highscore
As
Integer
Highscore = Sheets(
"Highscore"
).Range(
"B1"
).Value
Wand =
False
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
Randomize
Zufallszahl_1 = Int((39 - 10 + 1) * Rnd + 10)
Zufallszahl_2 = Int((39 - 10 + 1) * Rnd + 10)
Cells(Zufallszahl_1, Zufallszahl_2).Interior.Color = 1521525
Dim
j
As
Integer
, Zaehler
As
Integer
Weg = 1
Do
Select
Case
Weg
Case
1
If
ActiveCell.Offset(0, 1).Interior.Color = 1521525
Then
Range(
"AU30"
).Value = (Range(
"AU30"
).Value + 10)
End
If
If
ActiveCell.Offset(0, 1).Interior.Color = 5287936
Then
GoTo
G2
End
If
Case
2
If
ActiveCell.Offset(0, -1).Interior.Color = 1521525
Then
Range(
"AU30"
).Value = (Range(
"AU30"
).Value + 10)
End
If
If
ActiveCell.Offset(0, -1).Interior.Color = 5287936
Then
GoTo
G2
End
If
Case
3
If
ActiveCell.Offset(-1, 0).Interior.Color = 1521525
Then
Range(
"AU30"
).Value = (Range(
"AU30"
).Value + 10)
End
If
If
ActiveCell.Offset(-1, 0).Interior.Color = 5287936
Then
GoTo
G2
End
If
Case
4
If
ActiveCell.Offset(1, 0).Interior.Color = 1521525
Then
Range(
"AU30"
).Value = (Range(
"AU30"
).Value + 10)
End
If
If
ActiveCell.Offset(1, 0).Interior.Color = 5287936
Then
GoTo
G2
End
If
End
Select
Range(Laenge(0)).
Select
If
ActiveCell.Address = Toeszli_Adresse
Then
Selection.Interior.Pattern = xlNone
Groesse = UBound(Laenge) + 1
ReDim
Preserve
Laenge(Groesse)
Range(Laenge(Groesse - 1)).
Select
Select
Case
Weg
Case
1
Laenge(Groesse) = ActiveCell.Offset(0, 1).Address
Case
2
Laenge(Groesse) = ActiveCell.Offset(0, -1).Address
Case
3
Laenge(Groesse) = ActiveCell.Offset(-1, 0).Address
Case
4
Laenge(Groesse) = ActiveCell.Offset(1, 0).Address
End
Select
Range(Laenge(0)).
Select
Zaehler = Zaehler + 1
Else
Selection.Interior.Pattern = xlNone
Zaehler = 0
End
If
For
j = 0
To
(UBound(Laenge)) - 1
Laenge(j) = Laenge(j + 1)
Next
j
Range(Laenge(j)).
Select
If
Zaehler = 0
Then
Select
Case
Weg
Case
1
ActiveCell.Offset(0, 1).
Select
Case
2
ActiveCell.Offset(0, -1).
Select
Case
3
ActiveCell.Offset(-1, 0).
Select
Case
4
ActiveCell.Offset(1, 0).
Select
End
Select
End
If
If
Selection.Interior.Color = 1521525
Then
Toeszli_Adresse = ActiveCell.Address
Dim
k
As
Integer
G1:
Randomize
Zufallszahl_1 = Int((39 - 10 + 1) * Rnd + 10)
Zufallszahl_2 = Int((39 - 10 + 1) * Rnd + 10)
For
k = 0
To
Groesse
If
Cells(Zufallszahl_1, Zufallszahl_2).Address = Laenge(k)
Then
GoTo
G1
End
If
Next
k
Cells(Zufallszahl_1, Zufallszahl_2).Interior.Color = 1521525
End
If
Selection.Interior.Color = 5287936
Laenge(j) = ActiveCell.Address
If
Weg = 1
Then
If
Selection.Borders(xlEdgeLeft).Weight = xlMedium
Then
MsgBox (
"Verloren!!!!!!!"
)
Wand =
True
GoTo
G3
End
If
End
If
If
Weg = 2
Then
If
Selection.Borders(xlEdgeRight).Weight = xlMedium
Then
MsgBox (
"Verloren!!!!!!!"
)
Wand =
True
GoTo
G3
End
If
End
If
If
Weg = 3
Then
If
Selection.Borders(xlEdgeBottom).Weight = xlMedium
Then
G2:
MsgBox (
"Verloren!!!!!!!"
)
Wand =
True
GoTo
G3
End
If
End
If
If
Weg = 4
Then
If
Selection.Borders(xlEdgeTop).Weight = xlMedium
Then
MsgBox (
"Verloren!!!!!!!"
)
Wand =
True
GoTo
G3
End
If
End
If
Dim
Start
As
Double
Start = Timer
While
Timer < Start + 0.1
DoEvents
Wend
Loop
While
0 = 0
G3:
If
Range(
"AU30"
).Value > Highscore
Then
Sheets(
"Highscore"
).
Select
ActiveSheet.Unprotect Password:=
"1234"
Range(
"B1"
).
Select
Selection.Value = Sheets(
"Snake"
).Range(
"AU30"
).Value
MsgBox (
"WOW, neuer Highscore :D"
)
Sheets(
"Highscore"
).
Select
ActiveSheet.Protect DrawingObjects:=
True
, Contents:=
True
, Scenarios:=
True
, Password:=
"1234"
Sheets(
"Snake"
).
Select
Range(
"A1"
).
Select
End
If
End
Sub
Sub
Rechts()
Weg = 1
End
Sub
Sub
Links()
Weg = 2
End
Sub
Sub
Rauf()
Weg = 3
End
Sub
Sub
Runter()
Weg = 4
End
Sub