Discussion :

[Miiranda]

Re !

Alors déjà, un grand Merci (et au passage, désolée je n'avais pas vu votre second message vu qu'il s'est mis sur une deuxième page ^^)


Ensuite, j'ai testé votre Code il marche parfait, cependant je pense que je n'ai pas été assez explicite sur ce que j'attendais (enfin ce que le prof veut plutot LOL)

Il ne faut pas que le virus saute mais plutot qu'il "rampe". Par exemple, il est sur la cellule A6, il mange une cellule colorée A5 en se placant dessus et à la prochaine boucle, il regarde les 8 cellules autour de A5.

Je sais pas si je transmet bien ce à quoi je m'attend

En tout cas, un grand MERCI !!

[patricktoulon]

Re
J'avoue que c'est pas bien clair ton explication
cependant tu parle de ramper

alors a supposer que la bebete se trouve en a1 au départ
on démarre la boucle qui va me donner une destination aléatoire

ce que tu veux c'est que la bebete rampe de a1 a la cellule aléatoire et ainsi de suite ?????

si c'est le cas tu va avoir un problème quand la bebete va ramper jusqu'à destination elle va croiser une ou plusieur cellules coloriées que devra elle faire sur celles ci?????????

tu vois ou tu t'engage la!!!!!?????


Au plaisir

[Miiranda]

Re

Oui je comprend tout a fait le soucis, notre prof n'a pas été explicite sur ce point c'est ça le probleme, il nous a donné ça comme projet mais n'a pas plus argumenté

[patricktoulon]

re
Demain je te fairait un exemple animé ca va etre rigolo
mais la notion de simplicité est a oublier dans ce cas la lol!

au plaisir

[Miiranda]

Merciiii Infiniment !!!!!!

A demain alors

[Theze]

Bonjour et bonne fêtes,

Une autre possibilité, l'avancée est manuelle (mettre un bouton sur la feuille, lui affecter la macro "Virus") en cliquant successivement jusqu'à infection de toutes les cellules (il est aussi possible d'automatiser !).
Fonctionnement. La proc commence par rechercher toutes les cellules cibles (en rouge) dans la plage pour stocker les numéros de lignes et colonnes dans un tableau à deux dimensions, puis ce tableau est réorganisé pour une avancée aléatoire du virus vers ses cibles. Le point de départ est lui aussi défini de façon aléatoire. A chaque clic sur le bouton, la cellule en cours en colorée en vert (c'est le virus qui progresse car il se dirige vers sa première cible) si à proximité (dans les 8 cellules qui l'entourent hormis si la colonne est "A" ou la ligne est "1") il trouve une cellule rouge, il va la contaminer (colorée en bleu) puis reprends son trajet vers sa cible qu'il va coloré en bleu une fois atteinte :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
 
Dim Tbl() As Long
 
Dim Plage As Range
Dim Cel As Range
 
Dim Lgn As Long
Dim Col As Long
Dim PosCol As Long
Dim PosLgn As Long
Dim J As Long
Dim X As Long
Dim Y As Long
 
Dim Prox As Boolean
Dim Ini As Boolean
 
Sub Virus()
 
    Dim PlgProx As Range
    Dim CelProx As Range
    Dim C As Long
    Dim L As Long
 
    On Error GoTo Fin
 
    'initialise les variables
    If Ini = False Then
 
        Initialise
        Ini = True
 
    End If
 
    'si déjà initialisée, colore en bleu (contaminée) car la cellule est en vert (couleur du virus)
    If PosLgn <> 0 Then Plage(PosLgn, PosCol).Interior.ColorIndex = 5
 
    'supprime la couleur verte
    If Plage(Lgn, Col).Interior.ColorIndex = 10 Then Plage(Lgn, Col).Interior.ColorIndex = -4142
 
    '
    If X <> 0 Then If Plage(X, Y).Interior.ColorIndex = 10 Then Plage(X, Y).Interior.ColorIndex = -4142
 
    'évite d'incrémenter ou de décrémenter si la cible est une cellule à proximité
    If Prox = False Then
 
        'effectue un décalage de ligne et colonne en positif ou négatif selon position par rapport à la cible
        If Plage(Lgn, Col).Row < Tbl(1, J) Then Lgn = Lgn + 1
 
        If Plage(Lgn, Col).Row > Tbl(1, J) Then Lgn = Lgn - 1
 
        If Plage(Lgn, Col).Column < Tbl(2, J) Then Col = Col + 1
 
        If Plage(Lgn, Col).Column > Tbl(2, J) Then Col = Col - 1
 
    End If
 
    'pour l'effet visuel, la cellule en cours est colorée en vert
    If Plage(Lgn, Col).Interior.ColorIndex = -4142 Then Plage(Lgn, Col).Interior.ColorIndex = 10
 
    'si la couleur est rouge ou déjà en bleu
    If Plage(Lgn, Col).Interior.ColorIndex = 3 Or Plage(Lgn, Col).Interior.ColorIndex = 5 Then
 
        'si c'est la cellule cible (en rouge) incrémente pour la cible suivante
        If Plage(Lgn, Col).Address = Cells(Tbl(1, J), Tbl(2, J)).Address Then
 
            J = J + 1
 
        'sinon, si la cellule n'est pas la cellule cible mais qu'elle fait partie des cibles et qu'elle
        'n'a pas encore été contaminée (couleur bleu)
        ElseIf Plage(Lgn, Col).Interior.ColorIndex = 3 Then
 
            'redimensionne le tableau
            RedimTablo Tbl(), Lgn, Col
 
        End If
 
        'mémorise la position
        PosCol = Col
        PosLgn = Lgn
 
        'colore en vert (couleur du virus)
        Plage(Lgn, Col).Interior.ColorIndex = 10
 
    End If
 
    'si la cellule en cours n'est pas en ligne 1 ou colonne 1
    If Lgn > 1 Then L = -1
    If Col > 1 Then C = -1
 
    'mémorise pour supprimer la couleur verte de la cellule précédente
    X = Lgn
    Y = Col
 
    'défini la plage de proximité
    Set PlgProx = Plage.Range(Plage(Lgn, Col).Offset(L, C), Plage(Lgn, Col).Offset(1, 1))
 
    'parcour la plage à la recherche d'une cellule rouge
    For Each CelProx In PlgProx
 
        'si trouvée, redéfini la colonne et la ligne pour se diriger vers elle au prochain clic
        'mets la variable "Prox" à vrai et fin de boucle
        If CelProx.Interior.ColorIndex = 3 Then
 
            Col = CelProx.Column
            Lgn = CelProx.Row
            Prox = True
 
            Exit For
 
        End If
 
        'si rien trouver, pas de cellule à infecter à proximité
        Prox = False
 
    Next CelProx
 
Exit Sub
 
Fin:
Reinitialise
 
End Sub
 
Sub Initialise()
 
    Dim I As Long
 
    'défini la plage en dur
    Set Plage = Range("A1:O36")
 
    'mémorise l'emplacement des cellules colorées
    For Each Cel In Plage
 
        If Cel.Interior.ColorIndex = 3 Then
 
            I = I + 1
            ReDim Preserve Tbl(1 To 2, 1 To I)
            Tbl(1, I) = Cel.Row
            Tbl(2, I) = Cel.Column
 
        End If
 
    Next Cel
 
    Randomize
 
    Lgn = Int(Rnd * Plage.Rows.Count) + 1
    Col = Int(Rnd * Plage.Columns.Count) + 1
 
    J = 1
 
    'le tableau est redistribué de façon aléatoire
    Tri Tbl
 
End Sub
 
Sub Reinitialise()
 
    Set Plage = Nothing
    Erase Tbl()
    Set Cel = Nothing
    Ini = False
    Lgn = 0
    Col = 0
    J = 0
    PosCol = 0
    PosLgn = 0
    J = 0
    Prox = False
    X = 0
    Y = 0
 
End Sub
 
Sub Tri(Tablo() As Long)
 
    Dim Dico As Object
    Dim Cle As Variant
    Dim Tempo1 As Long
    Dim Tempo2 As Long
    Dim K As Long
 
    'initialise le générateur de nombres aléatoire
    Randomize
 
    'crée le dico
    Set Dico = CreateObject("Scripting.Dictionary")
 
    'boucle tant que toutes les positions non pas été trouvées
    Do
 
        K = Int(Rnd * UBound(Tablo, 2)) + 1
 
        If K <> 0 Then
 
            If Dico.exists(K) = False Then
 
                Dico.Add K, K
 
            End If
 
        End If
 
    Loop While Dico.Count <> UBound(Tablo, 2)
 
    K = 0
 
    'réorganise le tableau pour une avancée aléatoire
    For Each Cle In Dico.Keys
 
        K = K + 1
 
        Tempo1 = Tablo(1, K)
        Tempo2 = Tablo(2, K)
 
        Tablo(1, K) = Tablo(1, Cle)
        Tablo(2, K) = Tablo(2, Cle)
 
        Tablo(1, Cle) = Tempo1
        Tablo(2, Cle) = Tempo2
 
    Next Cle
 
End Sub
 
Sub RedimTablo(Tablo() As Long, Ligne As Long, Colonne As Long)
 
    Dim M As Long
    Dim N As Long
 
    For M = 1 To UBound(Tablo, 2)
 
        'quand trouvée, la supprime en déplacant les valeurs dans les dimensions et fin de boucle M
        If Tablo(1, M) = Ligne And Tablo(2, M) = Colonne Then
 
            For N = M To UBound(Tbl, 2) - 1
 
                Tbl(1, N) = Tbl(1, N + 1)
                Tbl(2, N) = Tbl(2, N + 1)
 
            Next N
 
            Exit For
 
        End If
 
    Next M
 
    'redimensionne en supprimant la dernière dimension qui ne sert plus à rien
    ReDim Preserve Tablo(1 To 2, 1 To UBound(Tablo, 2) - 1)
 
End Sub

Hervé.

[Theze]

Re,

Petite précision, il faut définir la plage dans la proc "Initialise". Dans mon code la plage est en "dur" en "A1:O36" :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
 
Set Plage = Range("A1:O36")

ou pour une sélection :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
 
Set Plage = Selection

Hervé.

[patricktoulon]

Bonjour Miiranda et theze

voila je reviens avec un model assez satisfaisant visuellement parlant
je ne me suis pas occupé des cellules adjacentes mais cela te sera facile de le rajouter

Alors voila :
Ouvre fichier vierge
Colle sur le sheets(1) :
2 boutons et un textbox (mUltiligne).(textbox1)
Ajoute aussi une petite figure a l'aide d'une forme automatique de ton choix
nimporte ou dans le sheets.
Nomme cette shape "toto".
cette shape aura les dimensions d'une cellule se sera notre petite bebete

maintenant dans le sheets colle ce code

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
 
Private Sub CommandButton1_Click()'ce bouton rafraichi le tableau au hazard a chaque fois 
new_level
End Sub
 
Private Sub CommandButton2_Click()'ce bouton lance le virus 
infestation
End Sub

maintenant dans un module standard colle ce code

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
 
Dim compte
Sub new_level()
 'on va remplir un nouveau tableau de cellules verte au hazard dans une boucle de 200 tours
      Dim z As Long
    Randomize
    Cells.Interior.Color = xlNone
    Do
        'on choisi une cellules de destination au hazard jusqua que la boucle ai atteint 200
        z = z + 1
        Cells((Rnd * 30) + 1, (Rnd * 30) + 1).Interior.Color = vbGreen
    Loop Until z = 200
End Sub
Sub infestation()
  Dim a As Long
    Randomize
    compte = 0
    Set loldcel = [a1] 'la cellule de depart pour la recherche la bebete partira de la
    Do
        DoEvents
        a = a + 1 'on incremente a de +1 a chaque tour
        Set lnewcel = Cells((Rnd * 30) + 2, (Rnd * 30) + 2) 'on choisi une cellule de destination au hazard
        deplacement loldcel, lnewcel 'on appele la fonction deplacement de la bebete avec les arguments cellule 1 et cellule2
        Set loldcel = lnewcel 'la cellule de destination devient la cellule de depart du prochain tour
        ActiveSheet.TextBox1 = "le virus a fait " & a & " bonds" 'on affiche le nombre  de rebonds de la bebete dans le textbox
    'pause 1000 'on fait une pause a chaque bond pour l'effet optique sinon ca va trop vite(facultatif)
    Loop Until a = 200 'recomence jusqu'a 200
    ActiveSheet.TextBox1 = "il y a eu " & vbCrLf & compte & " cibles atteintes" 'on affiche le resultat de cibles ateintes
 
End Sub
 
Function deplacement(oldcel, newcel)
Dim lacel, rowdiff, coldiff, nblig, nbcol, i, e
    'afin de savoir si on doit en lever ou ajouter +1 ou -1 a la cellule pour ce deplacer en direction de la cellules de destination
    ' on se servira de la "sgn"qui donne le pas negatif ou positif pour la colonne et la ligne
    rowdiff = Sgn(newcel.Row - oldcel.Row)
    coldiff = Sgn(newcel.Column - oldcel.Column)
    'on comptabilisele nombre de colonne et de ligne formée par la cellule de depart et la cellule de destination
    nbcol = Range(oldcel, newcel).Columns.Count - 1
    nblig = Range(oldcel, newcel).Rows.Count
 
    Do
        Set lacel = oldcel.Offset(rowdiff * i, coldiff * e) 'lacel=la cellule de depart - ou + 1 pour la ligne ,-1 ou+1 pour la colonne
        'on place la bebete sur la cellule
        ActiveSheet.Shapes("toto").Top = lacel.Top
        ActiveSheet.Shapes("toto").Left = lacel.Left
'on incremente i et e  dans la limite des ligne et colonne
        i = IIf(i + 1 < nblig, i + 1, nblig)
        e = IIf(e + 1 < nbcol, e + 1, nbcol)
        'Application.ScreenUpdating = True
        DoEvents
        pause 100 'on fait une pause effet optique sinon ca va trop vite
 
    Loop Until e = nbcol And i = nblig ' on boucle jusqu'a ce que l'on ai atteint le nombre de colonne et de ligne
    If oldcel.Offset(rowdiff * i, coldiff * e).Interior.Color = vbGreen Then 'si elle verte
        oldcel.Offset(rowdiff * i, coldiff * e).Interior.Color = vbRed 'on la met en rouge
        compte = compte + 1 'on comptabilise le nombre de cibles atteintes
    End If
    pause 500
 
    End Function
'fonction pour faire une  pause
Function pause(x)
    Do
     'DoEvents
        x = x + 1
    Loop Until x = 100000
End Function

On remercira mercatog qui m'a beaucoup aidé pour la fonction de deplacement de la bebete

amuse toi bien


Au plaisir