Tester les 8 cellules adjacentes

Bonjour,

je dois créer un automate cellulaire simulant un virus, ce qui me parait assez compliqué sachant que je débute en VBA.

La 1ère partie du programme affecte une couleur et un A à un nombre de cellule aléatoire dans une feuille de calcul .

La 2 ème partie doit permettre de poser un "virus" sur la feuille de calcul, si il possède une cellule verte avec un A dans son environnement direct (8cellules adjacentes) il l'a transforme en cellule noir avec un V, sinon il se déplace dans l'une des 8 directions ,d'une cellule. Ce virus à un nombre de déplacement limité, si il "mange" une cellule avec un A, il remet son nombre de déplacement au max.

Pourriez vous m'aider à écrire un test permettant de tester si une ou plusieurs cellules adjacentes à une cellule aléatoire ont un A, que je puisse ensuite utiliser les données de sortie (il y a une A ou non).

Cordialement

Voici le code de la 1ère partie qui fonctionne :

NB = 0

K = 0

compte = 0

A = InputBox("veuillez saisir le nombre de colonne")

B = InputBox("veuillez saisir le nombre de la ligne")

Do

Randomize

X = Int(A * Rnd) + 1

Y = Int(B * Rnd) + 1

If Cells(X, Y).Value = "A" Then

K = 1

Else: Cells(X, Y).Value = "A"

NB = NB + 1

End If

If Cells(X, Y).Value = "A" Then

Cells(X, Y).Interior.ColorIndex = 10

End If

Loop While K = 0

MsgBox ("end")

Cells(1.1) = NB

Bonjour,

je suis aussi (peu) doué que toi en vba, donc je n'écris pas pour te donner une réponse ! Mais ta demande me fait beaucoup penser au petit jeu "Démineur" sur windows !! Le concept est visiblement le même, car il faut agir sur des cellules autour du clic.

Tu as pensé à regarder sur internet des fichiers excel vba "jeu démineur" ? Peut être que ça pourrait être un début de réponse pour savoir comment organiser le code etc ...

Bonne recherche

Salut,

un bout de la solution avec les commentaires

Sub Game()
On Error Resume Next 'évitera au programme de planter si le virus s'approche trop près du bord de la feuille
Range(Selection.Offset(-1, -1), Selection.Offset(1, 1)).Select 'définit la zone des 8 cellules adjacentes _
depuis la cellule en haut à gauche (-1,-1) _
jusqu'à la cellule en bas à droite (1,1) de la cellule centrale

For Each monCompteur In Selection 'Pour chaque élément (cellule) de cette plage
    If monCompteur.Value = "A" Or monCompteur.Value = "a" And monCompteur.Interior.Color = 5287936 Then 'si la valeur de l''élément testé _
    est A et la couleur de fond de l'élément est vert (5287936)
    monCompteur.Value = "V" 'alors la valeur de l'élément devient V
    monCompteur.Interior.Color = vbBlack 'sa couleur devient noire
    monCompteur.Font.Color = vbGreen 'pour voir le V dans la cellule noire
    End If
Next monCompteur 'passe à l'analyse de l'élément suivant de la plage
End Sub

Merci Game Over

voici le code complet :

Dim x As Integer, y As Integer, myRange As Range, myRange2 As Range, _
xx As Integer, yy As Integer, z As Integer, compteur As Integer, n As Range

Sub Jeu()

Range("A1", "J10").Delete 'efface la plage de jeu

'initialisation des variables
xx = 0
yy = 0
z = 0
compteur = 0

For a = 1 To 5 'création aléatoire de 5 cibles

    Randomize
    x = Int(Rnd * 10) + 1
    Randomize
    y = Int(Rnd * 10) + 1

    Cells(x, y).Select
    ActiveCell = "A"
    ActiveCell.Interior.Color = vbGreen

Next a

'positionnement aléatoire du curseur dans la plage de jeu
Randomize
x = Int(Rnd * 10) + 1
Randomize
y = Int(Rnd * 10) + 1

Cells(x, y).Select

'nbre d 'essais défini à 5
compteur = 5
For compteur = 5 To 1 Step -1
    area
Next compteur
End Sub

Sub area()

'création de la plage d'action autour du curseur (cellules adjacentes)
Set myRange = ActiveCell 'position du curseur dans l'aire de jeu
xx = myRange.Row 'No de ligne
yy = myRange.Column 'No de colonne

ActiveCell.Borders.LineStyle = xlContinuous 'definition visuelle du curseur

If ActiveCell.Row = Range("A1").Row And ActiveCell.Column = Range("A1").Column Then 'si le curseur se place dans la cellule A1
    Range(Selection, Selection.Offset(1, 1)).Select 'redéfinition de sa zone d'action

    ElseIf ActiveCell.Row = 1 Then 'si le curseur se place sur la 1ere ligne (1)
        Range(Selection.Offset(0, -1), Selection.Offset(1, 1)).Select

            ElseIf ActiveCell.Column = 1 Then 'si le curseur se place sur la 1ere colonne (A)
                Range(Selection.Offset(-1, 0), Selection.Offset(1, 1)).Select

                Else 'si le curseur n'est pas immédiatement délimité
                    Range(Selection.Offset(-1, -1), Selection.Offset(1, 1)).Select

End If

Set myRange2 = Selection 'définition de la zone d'action du curseur

R = 0
For Each n In myRange2 'pour chaque cellule de la zone d'action
    If n.Value = "A" Or n.Value = "a" And n.Interior.Color = 5287936 Then 'si la valeur de l'élément testé _
        est A et la couleur de fond de l'élément est vert (5287936)
        n.Value = "V" 'alors la valeur de l'élément devient V
        n.Interior.Color = vbBlack 'sa couleur devient noire
        n.Font.Color = vbGreen 'pour voir le V dans la cellule noire
        R = 1 'signifie que le virus a trouvé une cible
        n.Select
        myRange.Borders.LineStyle = xlNone ' efface l'ancien curseur
        Set myRange = n 'le curseur prend la place de la cible

        compteur = 5 'compteur rétabli à 5
    End If
Next n

If R = 0 Then 'le virus n'a pas trouvé de cible
try
End If

End Sub
Sub try()

'le curseur prend avance aléatoirement d'une case dans sa zone d'action
Randomize
z = myRange2.Cells.Count
z = Int(Rnd * z) + 1
myRange2.Cells(z).Select

If ActiveCell.Row = myRange.Row And ActiveCell.Column = myRange.Column Then 'si le résultat aléatoire = l'ancienne place du curseur alors recommence
    try
End If
myRange.Borders.LineStyle = xlNone

End Sub

si tu veux voir quelque chose, utilise le mode pas à pas (F8).

j'ai arbitrairement choisi le nombre d'essais et le nombre de cibles à 5.

tu pourras les changer ou demander à l'utilisateur de les définir.

peut être qu'il faudrait utiliser les MsgBox entre chaque mouvement pour pouvoir voir les déplacements.

J'ai adapté avec mes besoins. Merci beaucoup Game