Thema
|
Datum
|
Von Nutzer
|
Rating
|
Antwort
|
|
10.02.2011 09:59:15 |
Samse |
|
|
|
10.02.2011 10:11:15 |
Severus |
|
|
|
10.02.2011 10:28:58 |
Samse |
|
|
|
10.02.2011 10:44:52 |
Severus |
|
|
|
10.02.2011 10:47:54 |
Samse |
|
|
|
10.02.2011 10:58:03 |
Severus |
|
|
|
10.02.2011 11:08:48 |
Samse |
|
|
|
10.02.2011 12:01:51 |
Severus |
|
|
Keydown wie geht das? |
10.02.2011 12:40:19 |
Gast44226 |
|
|
|
10.02.2011 12:56:19 |
Severus |
|
|
|
10.02.2011 13:01:39 |
Samse |
|
|
|
10.02.2011 14:57:29 |
Severus |
|
|
|
10.02.2011 15:55:45 |
Samse |
|
|
|
11.02.2011 07:55:02 |
Severus |
|
|
|
01.03.2011 14:28:05 |
Samse |
|
|
Von:
Gast44226 |
Datum:
10.02.2011 12:40:19 |
Views:
703 |
Rating:
|
Antwort:
|
Thema:
Keydown wie geht das? |
Geht nicht...:S
Es kommt immer der Laufzeitfehler '28' Nicht genügend Stapelspeicher :S
Wenn ich auf Debuggen klicke wird mier der erst Unload Befehl gelb markiert...:S
Hab ich auch alles richtig gemacht ?
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
Application.OnKey "{RIGHT}", "Rechts"
Application.OnKey "{UP}", "Rauf"
Application.OnKey "{DOWN}", "Runter"
Application.OnKey "{LEFT}", "Links"
End Sub
Function Rechts()
Unload Runter
Unload Links
Unload 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(0, 1).Select
Selection.Interior.Color = 5287936
Laenge(4) = ActiveCell.Address
Dim Start As Double
Start = Timer
While Timer < Start + 0.01
DoEvents
Wend
If Wand = True Then
Exit Function
End If
If Selection.Borders(xlEdgeLeft).Weight = xlMedium Or Wand = True Then
MsgBox ("Verloren!!!!!!!")
Wand = True
Exit Function
End If
Loop While 0 = 0
End Function
Function Links()
Unload Runter
Unload Rechts
Unload Rauf
Dim j As Integer
Do
Range(Laenge(0)).Select
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
While Timer < Start + 0.01
DoEvents
Wend
If Wand = True Then
Exit Function
End If
If Selection.Borders(xlEdgeRight).Weight = xlMedium Then
MsgBox ("Verloren!!!!!!!")
Wand = True
Exit Function
End If
Loop While 0 = 0
End Function
Function Rauf()
Unload Runter
Unload Rechts
Unload 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(-1, 0).Select
Selection.Interior.Color = 5287936
Laenge(4) = ActiveCell.Address
While Timer < Start + 0.01
DoEvents
Wend
If Wand = True Then
Exit Function
End If
If Selection.Borders(xlEdgeBottom).Weight = xlMedium Or Wand = True Then
MsgBox ("Verloren!!!!!!!")
Wand = True
Exit Function
End If
Loop While 0 = 0
End Function
Function Runter()
Unload Rauf
Unload Rechts
Unload 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(1, 0).Select
Selection.Interior.Color = 5287936
Laenge(4) = ActiveCell.Address
While Timer < Start + 0.01
DoEvents
Wend
If Wand = True Then
Exit Function
End If
If Selection.Borders(xlEdgeTop).Weight = xlMedium Or Wand = True Then
MsgBox ("Verloren!!!!!!!")
Wand = True
Exit Function
End If
Loop While 0 = 0
End Function
Gruss
Samse
|
- Bitte beschreiben Sie Ihr Problem möglichst ausführlich. (Wichtige Info z.B.: Office Version, Betriebssystem, Wo genau kommen Sie nicht weiter)
- Bitte helfen Sie ebenfalls wenn Ihnen geholfen werden konnte und markieren Sie Ihre Anfrage als erledigt (Klick auf Häckchen)
- Bei Crossposting, entsprechende Links auf andere Forenbeiträge beifügen / nachtragen
- Codeschnipsel am besten über den Code-Button im Text-Editor einfügen
- Die Angabe der Emailadresse ist freiwillig und wird nur verwendet, um Sie bei
Antworten auf Ihren Beitrag zu benachrichtigen
Bitte geben Sie ein aussagekräftiges Thema an.
Bitte geben Sie eine gültige Email Adresse ein!
- Bitte beschreiben Sie Ihr Problem möglichst ausführlich. (Wichtige Info z.B.: Office Version, Betriebssystem, Wo genau kommen Sie nicht weiter)
- Bitte helfen Sie ebenfalls wenn Ihnen geholfen werden konnte und markieren Sie Ihre Anfrage als erledigt (Klick auf Häckchen)
- Bei Crossposting, entsprechende Links auf andere Forenbeiträge beifügen / nachtragen
- Codeschnipsel am besten über den Code-Button im Text-Editor einfügen
- Die Angabe der Emailadresse ist freiwillig und wird nur verwendet, um Sie bei
Antworten auf Ihren Beitrag zu benachrichtigen
Thema
|
Datum
|
Von Nutzer
|
Rating
|
Antwort
|
|
10.02.2011 09:59:15 |
Samse |
|
|
|
10.02.2011 10:11:15 |
Severus |
|
|
|
10.02.2011 10:28:58 |
Samse |
|
|
|
10.02.2011 10:44:52 |
Severus |
|
|
|
10.02.2011 10:47:54 |
Samse |
|
|
|
10.02.2011 10:58:03 |
Severus |
|
|
|
10.02.2011 11:08:48 |
Samse |
|
|
|
10.02.2011 12:01:51 |
Severus |
|
|
Keydown wie geht das? |
10.02.2011 12:40:19 |
Gast44226 |
|
|
|
10.02.2011 12:56:19 |
Severus |
|
|
|
10.02.2011 13:01:39 |
Samse |
|
|
|
10.02.2011 14:57:29 |
Severus |
|
|
|
10.02.2011 15:55:45 |
Samse |
|
|
|
11.02.2011 07:55:02 |
Severus |
|
|
|
01.03.2011 14:28:05 |
Samse |
|
|