|
Hallo Severus
ich war einige Zeit nich an meiner Arbeit dran...
Jezt hab ich wieder angefangen und meinen Code umstrukturiert...:D
Jezt funzt das mit den Knöpfen nicht mehr :S
Kanste mier weiterhelfen?
Hier der Code:
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()
'====================================================================
'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("AU:AU").ColumnWidth = 3.5
Range("AU30").Value = 0
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, 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
'====================================================================
'"Tözli" entstehen lassen
'====================================================================
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
'====================================================================
'Snake laufen lassen
'====================================================================
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
|