XL 2016 VBA - Démineur

[Lazz]

Bonjour à tous,

Je suis très novice en VBA, mais je me lance dans le jeu du "DEMINEUR".
Et je dois avouer que je pensais que ce serait plus simple que ça !

* 1 ère étape : j'aimerai initialiser mon jeu. Pour cela, je veux griser les cellules de la plage L1C1 : L10C10, vider le contenu éventuel, initialiser la police comme "non grasse" et que ma cellule sélectionnée à la fin soit la L11C11.
Voilà ce que j'ai réussi à faire :

'Initialisation de la grille
For l = 10 To p
For c = 2 To g
Cells(l, c) = 0
Worksheets("SOLUTION").Cells(l, c) = 0
Cells(l, c).Interior.Color = RGB(200, 200, 200) ' affecte une couleur de départ
Cells(l, c).RowHeight = 20 ' uniformiser la hauteur la cellule
Cells(l, c).ColumnWidth = 3 ' uniformiser la largeur de la cellule

*2 ème étape : j'aimerai placer aléatoirement 15 mines sur ma grille. Je sais qu'il faut utiliser la fonction WorksheetFunction.RandBetween(1, 10) qui retourne un nombre aléatoire entre 1 et 10 mais je ne sais pas comment tourner mon code....

Pour l'instant je m'arrête là pour mes questions. Si vous pouvez déjà m'aider sur les 2 premières étapes c'est top !!
Merci beaucoup 🙂

 

[Dranreb]

Personnellement j'utiliserai un objet de mon type ListeAléat dont voici le code du module de classe du nom de ce type :

Option Explicit
Public PCou As Long 'Propriété: Position courante du dernier numéro rendu par Suivant
Private Joueur() As Long, PMax As Long
Private Posit() As Long, JMax As Long
Public Sub Init(ByVal Nombre As Long)
Rem. Méthode. Initialise l'objet aux numéros allant de 1 au Nombre spécifié.
'           Il vous appartient en principe d'exécuter une instruction Randomize auparavant.
'           La méthode ne l'assume pas, afin que vous en gardiez la maitrise. Exemple :
'              MaGraine = Date Mod 7 + Time: Rnd -1: Randomize MaGraine
   Dim P As Long
   ReDim Joueur(1 To Nombre): For P = 1 To Nombre: Joueur(P) = P: Next P
   PMax = Nombre: Désordre
   End Sub
Public Sub Désordre()
Rem. Méthode. Re-change aléatoirement l'ordre des numéros. Init le fait déjà une 1ère fois.
   Dim P As Long, R As Long, J As Long
   For P = PMax To 2 Step -1
      R = Int(Rnd * P) + 1: J = Joueur(R): Joueur(R) = Joueur(P): Joueur(P) = J
      Next P
   RectifierPositions
   End Sub
Public Function Aléat(Optional ByVal P As Long = 1) As Long
Rem. Méthode. Renvoie un numéro au hasard.
'           P: Position dans la liste du numéro souhaité.
'              Facultatif: 1 assumé ce qui qui correspond à celui de tête de liste.
'           Renvoie 0 si P est supérieur au nombre de numéros portés dans l'objet.
   If P > PMax Then Aléat = 0 Else Aléat = Joueur(P)
   End Function
Public Sub Supprimer(ByVal J As Long)
Rem. Méthode. S'il y figure encore, supprime de l'objet le numéro J spécifié.
'           S'il s'agit du numéro juste rendu précédemment par Suivant,
'           la position courante du prochain à rendre sera reprise.
'           À sa position, ce numéro sera remplacé par celui figurant en fin de liste.
   Dim P As Long
   P = Posit(J): If P = 0 Then Exit Sub
   Posit(J) = 0
   If P < PMax Then J = Joueur(PMax): Joueur(P) = J: Posit(J) = P
   Joueur(PMax) = 0: PMax = PMax - 1
   If PCou = P Then PCou = P - 1
   End Sub
Public Sub Remettre(ByVal J As Long, Optional ByVal P As Long = &H7FFFFFFF)
Rem. Méthode. Replace le numéro J à la position P (Maxi + 1 assumé si non spécifié)
'           Si P est supérieur au nombre de numéros portés, il est rectifié à ce nombre + 1.
'           Si le numéro J exite déja à une autre position, il est échangé avec celui en P.
'           Sinon le numéro figurant préalablement à la position P est chassé en fin de liste.
'           Ceci a pour conséquence de remettre l'objet dans le même état que si J figurait
'           à la position P quand il a été rendu par Aléat avant d'être supprimé.
   Dim Q As Long, A As Long
   Q = Posit(J): If P < 1 Then P = 1
   If Q = 0 Then PMax = PMax + 1
   If P > PMax Then P = PMax
   If Q = P Then Exit Sub
   If Q = 0 And P < PMax Then Q = PMax
   If Q > 0 Then A = Joueur(P): Joueur(Q) = A: Posit(A) = Q
   Joueur(P) = J: Posit(J) = P
   End Sub
Public Function Existe(ByVal J As Long) As Boolean
Rem. Méthode. Indique si le numéro J spécifié est encore porté dans l'objet.
   Existe = Posit(J) > 0
   End Function
Public Function Pos(ByVal J As Long) As Long
Rem. Méthode. Renvoie la position dans l'objet à laquelle est porté le numéro J spécifié.
   Pos = Posit(J)
   End Function
Public Function Count()
Rem. Propriété en lecture seule. Renvoie le nombre de numéros disponibles.
   Count = PMax
   End Function
Public Function Suivant() As Long
Rem. Méthode. Renvoie un numéro au hasard mais avec la possibilité d'en demander un autre par la
'           suite s'il ne convient pas. Renvoie 0 si plus aucun numéro n'est disponible.
'           La séquence des numéros successivement rendus est abandonnée par l'emploi de l'une
'           des méthodes RàZSuc, ClonéDe, Init ainsi que lors d'une affectation à Table et par
'           la méthode Supprimer pour un numéro que cette méthode Suivant a rendu antérieurement
'           à son invocation la plus récente. Sans numéro indiqué, Supprimer n'en perd donc pas
'           le fil, ni jamais la méthodes Existe, ni la propriété Table utilisée en lecture.
   If PCou < PMax Then PCou = PCou + 1: Suivant = Joueur(PCou) Else Suivant = 0
   End Function
Public Property Let Table(TJ() As Long)
Rem. Propriété en lecture/écriture. Table des numéros contenus dans l'objet.
'           Attention: Sa dimension n'est pas ajustée au nombre de numéros qu'elle porte
'           mais au numéro le plus grand qu'elle pourrait porter. Elle se termine donc par
'           des 0 à la fin s'ils n'y figurent plus tous.
   Joueur = TJ: RectifierPositions
   End Property
Public Property Get Table() As Long()
   Table = Joueur
   End Property
Function PartieClassée(Optional ByVal Nombre As Long) As Long()
Rem. Méthode. Renvoie un tableau de numéros en ordre croissant (genre tirage Loto)
'           Nombre: Le nombre maximum de numéros souhaités. Facultatif. Si omis, le
'                 nombre de numéros figurant encore dans l'objet est assumé.
   ExtraireClassés PartieClassée, Nombre
   End Function
Public Sub ExtraireClassés(T() As Long, Optional ByVal Nombre As Long)
Rem. Méthode. fabrique un tableau des numéros en ordre croissant (genre tirage Loto).
'           Nombre: Le nombre maximum de numéros souhaités. Facultatif. Si omis, ou trop
'                 grand, le nombre de numéros figurant encore dans l'objet est assumé.
   Dim J As Long, P As Long, N As Long
   If Nombre <= 0 Then Nombre = PMax
   ReDim T(1 To Nombre)
   For J = 1 To JMax
      P = Posit(J): If P > 0 And P <= Nombre Then N = N + 1: T(N) = J
      Next J
   End Sub

Rem. N'hésitez pas à utiliser de nombreux tableaux d'objets de type ListeAléat.
'    Il en faut au moins déja un par manche: le ListAléat des joueurs restant à apparier

Rem. Procédure à usage interne
Private Sub RectifierPositions()
   Dim P As Long, J As Long
   JMax = UBound(Joueur)
   ReDim Posit(1 To JMax)
   PMax = 0
   For P = 1 To JMax: J = Joueur(P): If J = 0 Then Exit For
      Posit(J) = P: PMax = P: Next P
   PCou = 0
   End Sub

 

[dysorthographie]

Bonsoir,

 

[Lazz]

Bonjour @dysorthographie

Comme je le disais, je suis novice dans le VBA et je ne comprends pas tout... J'aimerais faire étape par étape avec mes méthodes que j'ai expliqué ci-dessus...

Merci tout de même pour ton fichier qui m'a l'air de parfaitement fonctionner 🙂

 

[Dranreb]

À supposer qu'un nom "Grille" ait été donné à la grille dans le classeur, et que mon module de classe ait été implanté, voici le code qui ferait ce que vous dites :

Option Explicit
Sub RenseignerGrille()
   Dim RngGrille As Range, XMax As Long, YMax As Long, P As Long, N As Long
   Set RngGrille = Feuil1.[Grille]
   XMax = RngGrille.Columns.Count
   YMax = RngGrille.Rows.Count
   RngGrille.Interior.Color = RGB(186, 186, 186)
   RngGrille.Font.Bold = False
   Randomize
   With New ListeAléat
      .Init XMax * YMax
      For P = 1 To 15
         N = .Aléat(P)
         RngGrille((N - 1) \ XMax + 1, (N - 1) Mod XMax + 1).Interior.Color = 0
         Next P
      End With
   End Sub

 

[Lazz]

À supposer qu'un nom "Grille" ait été donné à la grille dans le classeur, et que mon module de classe ait été implanté, voici le code qui ferait ce que vous dites :

Option Explicit
Sub RenseignerGrille()
   Dim RngGrille As Range, XMax As Long, YMax As Long, P As Long, N As Long
   Set RngGrille = Feuil1.[Grille]
   XMax = RngGrille.Columns.Count
   YMax = RngGrille.Rows.Count
   RngGrille.Interior.Color = RGB(186, 186, 186)
   RngGrille.Font.Bold = False
   Randomize
   With New ListeAléat
      .Init XMax * YMax
      For P = 1 To 15
         N = .Aléat(P)
         RngGrille((N - 1) \ XMax + 1, (N - 1) Mod XMax + 1).Interior.Color = 0
         Next P
      End With
   End Sub

Merci @Dranreb cela sert à faire la première étape de mon code c'est bien cela ?

As tu une idée pour la deuxième étape ?

Merci à toi 🙂

 

[Dranreb]

Si, pour la 2ième étape il place bien 15 cases noires sur la grille. C'est ce que j'ai symbolisé comme étant une mine.