Thema Datum  Von Nutzer Rating
Antwort
Rot Doevents
09.02.2011 16:40:25 Samse
Solved
09.02.2011 16:54:42 Severus
NotSolved
10.02.2011 08:22:17 Gast24374
NotSolved
10.02.2011 09:46:59 Severus
NotSolved

Ansicht des Beitrags:
Von:
Samse
Datum:
09.02.2011 16:40:25
Views:
2123
Rating: Antwort:
 Nein
Thema:
Doevents

Hallo Zusammen

Ich programmiere gerade das Spiel Snake in Excel.

Der Spieler soll die Schlange selbst lenken, das habe ich mit Peilbildern und Makrozuweisungen Realisiert.

Hierzu brauche ich den Befehl Doevent, sodass er die Richtung wechseln kann.

Nun das Problem: Wenn ich doevent brauche, läuft ja das ander programm immer noch und das will ich nicht.

Kann man das irgenwie abschalten? Also einen befehl der einen anderen Sub anhält?

Hier mein Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
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()
 
'====================================================================
'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, 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

Danke im Vorraus :D


Ihre Antwort
  • 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: Name: Email:



  • 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
Rot Doevents
09.02.2011 16:40:25 Samse
Solved
09.02.2011 16:54:42 Severus
NotSolved
10.02.2011 08:22:17 Gast24374
NotSolved
10.02.2011 09:46:59 Severus
NotSolved