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
| Option Explicit
Dim compteur As Integer ' (si max 200)
Dim maplage As Range
Dim nb_couleur As Integer
Dim prem_pos As Boolean
Dim pos_anter As Integer
Sub lance()
Dim i As Integer
Dim ma_plage As Range
Dim reponse As Integer
' définition de la plage globale de 16 colonnes et 20 lignes
Set maplage = Range("B51:Q71")
' positionnement aléatoire de la première cellule du jeu
If prem_pos = False Then
maplage.Cells(Int((336 * Rnd) + 1)).Select
prem_pos = True
End If
If nb_couleur = 0 Then
reponse = MsgBox("Il n'y a pas de cellule colorée, voulez-vous lancer le jeu ? ", vbYesNo, " lancement du jeu")
If reponse = 7 Then Exit Sub
Coloration_cellules
' si le nb de cellules colorées est aléatoire
CompteCouleurFond
End If
' puis on cherche si cellule couleur à proximité
For i = 1 To 9
Set ma_plage = Range(ActiveCell.Offset(-1, -1), ActiveCell.Offset(1, 1))
If i = 5 Then i = 6
If ma_plage.Cells(i).Interior.ColorIndex = 3 Then
ma_plage.Cells(i).Select
ma_plage.Cells(i).Interior.ColorIndex = 4
' remise à zéro du compteur
compteur = 0
' on décompte le nombre de cellules colorées
nb_couleur = nb_couleur - 1
If nb_couleur = 0 Then MsgBox "Il n'y a plus de cellule colorée"
Exit Sub
End If
Next i
' sinon tirage aléatoire pour nouvel emplacement avec compteur si 1 cellule couleur 3 n'est pas trouvée
cherche
End Sub
Sub CompteCouleurFond()
Dim c As Range
nb_couleur = 0
For Each c In maplage
If c.Interior.ColorIndex = 3 Then
nb_couleur = nb_couleur + 1
End If
Next c
End Sub
Sub Coloration_cellules()
' tirage aléatoire des cellules en couleur
End Sub
Sub cherche()
Dim cel_act As String
Dim col As Integer
Dim i As Integer
Dim lign As Integer
Dim macolonne As Integer
Dim maligne As Integer
Dim maval As Integer
Dim mazone As Range
Dim mc As Range
Dim myvalue As Integer
Dim Montab()
Dim tab1(), tab2(), tab3(), tab4(), tab5(), tab6(), tab7(), tab8(), tab9()
Set mc = ActiveCell
Set mazone = Range(ActiveCell.Offset(-1, -1), ActiveCell.Offset(1, 1))
' position dans la plage de la cellule.select (mc)
col = maplage.Cells(1).Column - 1
lign = maplage.Cells(1).Row - 1
cel_act = mc.AddressLocal(ReferenceStyle:=xlR1C1, _
RowAbsolute:=False, _
ColumnAbsolute:=False, _
RelativeTo:=Worksheets(1).Cells((maplage.Cells(1).Row - 1), (maplage.Cells(1).Column - 1)))
maligne = Mid(cel_act, InStr(cel_act, "(") + 1, InStr(cel_act, ")") - (InStr(cel_act, "(") + 1))
macolonne = Mid(Mid(cel_act, InStr(cel_act, ")") + 3), 1, Len(Mid(cel_act, InStr(cel_act, ")") + 3)) - 1)
maval = ((maligne - 1) * 16) + macolonne
' initialisation des positions
tab1 = Array(0, 0, 0, 0, 0, 6, 0, 8, 9)
tab2 = Array(0, 0, 0, 4, 0, 0, 7, 8, 0)
tab3 = Array(0, 2, 3, 0, 0, 6, 0, 0, 0)
tab4 = Array(1, 2, 0, 4, 0, 0, 0, 0, 0)
tab5 = Array(0, 0, 0, 4, 0, 6, 7, 8, 9)
tab6 = Array(0, 2, 3, 0, 0, 6, 0, 8, 9)
tab7 = Array(1, 2, 0, 4, 0, 0, 7, 8, 0)
tab8 = Array(1, 2, 3, 4, 0, 6, 0, 0, 0)
Montab = Array(tab1, tab2, tab3, tab4, tab5, tab6, tab7, tab8)
' tirage aléatoire de la future position cellule
recommence:
Randomize
myvalue = Int((9 * Rnd) + 1)
If myvalue = 5 Then GoTo recommence
If myvalue = pos_anter Then GoTo recommence
If maval > 16 And maval < 321 Then If maval Mod 16 = 1 Then maval = 1000
If maval Mod 16 = 0 And maval <> 336 Then maval = 0
Select Case maval
Case 0: i = 6
Case 1: i = 0
Case 16: i = 1
Case 321: i = 2
Case 336: i = 3
Case 2 To 15: i = 4
Case 322 To 335: i = 7
Case 1000: i = 5
End Select
If Montab(i)(myvalue - 1) = 0 Then
GoTo recommence
End If
' on selectionne la nouvelle position de la cellule.select (mc)
mazone.Cells(myvalue).Select
' on enregistre la position pour ne pas revenir sur celle-ci au prochain tirage
pos_anter = 10 - myvalue
' comptage du manque de cellule de couleur
compteur = compteur + 1
End Sub |
Projet Création virus
Répondre avec citation
(n'ayant pas testé). Tu as raison il faut écrire :
C'est frustrant de pas trouver après autant d'essais ! 
: ça peut servir aux autres 
Partager