Hallo Zusammen
Ich habe da ein kleines Problem. Ich programmiere schon seit tagen an meinem Sanke in VBA herum. Es funktioniert alles tip top. Nun will ich das das der Spieler mit den Pfeiltasten lenken soll. Ich weiss das es mit der Keydown Funktion funktionieren würde, aber ich versteh die irgenwie nicht :S
Hier mein momentaner 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
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
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
Gruss
Samse
|