... Tu me manques :'(
.. @gmail.com
Aujourd'hui je vous propose de rouvrir une Rubrique restée en sommeil depuis un certain temps, la Rubrique VB-VBA, avec un Programme sous MS Excel qui génère des tirages façon "Le Compte Est Bon", mais surtout les résout !
Rem: Devrait suivre prochainement la version MS Word, plus répandu chez les particuliers ;)
0) Présentation :
"Le Compte Est Bon" (janvier 1972) est, avec "Le Mot Le Plus Long" (septembre 1965), l'une des deux phases du plus ancien Jeu Télévisé encore existant de nos jours, "Des Chiffres Et Des Lettres", un concept simple et intelligent en même temps, aux antipodes de ces jeux où il faut estimer le prix d'une machine à laver, puis classer du moins cher au plus cher une conserve de raviolis, un paquet de rasoirs jetables, un tube de vaseline et une botte de poireaux, pour espérer remporter la fifille dans la vitrine, ou quelque chose comme ça.. :P
Un Jeu inventé par Armand Jammot, présenté à l'origine par Patrice Laffont, et toujours à l'antenne sur France Télévisions. De temps à autre, nous ressortons la boîte de jeu de l'époque (voir photo..), et faisons des parties (non chronométrées) avec la Miss, histoire de changer du Scrabble, autre jeu de société intelligent.
==> Lire en intégralité
-MyLzz59-
Important## Comment "marche" ce Blog / Comment laisser un Commentaire ##
Et pour finir,
N'oubliez pas de visiter aussimon blog d'histoires ====>
-MyLzz59-
jeudi 21 mars 2013
BF_LCEB: "Le Compte Est Bon !"
mercredi 13 octobre 2010
MSG-Mind (P)08/2010 MyLzz59
(Rubrique VB-VBA)
0) Intro
Nouvelle incursion dans le monde de la programmation VB/VBA, avec cette fois une réalisation bien plus simple que les trois précédentes (nan, pas "réunies" ) "Boules", "Bombes", et surtout "Tris (Tetris)".
Déjà ces dernières utilisent comme interface une feuille Excel (pas si répandu que cela chez les particuliers..), de plus (et tout particulièrement "Tris") elles multiplient les appels de procédures dont des événementielles.
Ici, tel un retour aux sources, une seule procédure, de moins de deux écrans (éditeur) de long, lignes de commentaires comprises. En outre, ce code est indépendant de l'application hôte, aussi il fonctionnera quelle que soit celle choisie (Word, Excel, Powerpoint, etc..)
J'en profiterai au passage (à la source ) pour revenir sur quelques notions "ancestrales" de Basic, que j'utilise couramment dans mes codes, et particulièrement ici
1) MasterMind
a] Généralités
Ce jeu de logique fait partie des "classiques" des jeux de société. Il a été inventé dans les années 1960 par l'Israélien Mordecaï Meirowitz, et a été commercialisé en France en 1976 (Hasbro). Il se présente sous la forme d'une boîte trouée et de "punaises" de diverses couleurs.
==> Lire en intégralité
-MyLzz59-
vendredi 11 juin 2010
Tris (P)06/2010 MyLzz59
(Rubrique VB-VBA)
0) Intro
J'enrichis ce jour cette rubrique VB/VBA avec un nouveau programme VBA sous Excel, dans la continuité des deux précédents, Boules, et Bombes. Un programme "suggéré" par Taz lors d'un commentaire récent, que j'ai pris comme un "petit défi". Oh, toutes proportions gardées, car bien que ce programme soit un peu plus "étoffé" que les précédents, il n'en reste pas moins une réalisation simple..
Je vous propose de me suivre pas à pas dans la mise en place de ce nouveau jeu, en fait un ..Tétris dans une feuille Excel . Une petite remarque: n'hésitez pas à vous référer aux explications des deux programmes précédents, la "difficulté" étant croissante je me focaliserai sur les "nouveautés".
1) Un Tétris ?
a] Généralités
Ce jeu de pièces à imbriquer façon puzzle a été inventé en urss en 1984 par Alexei Pajitnov, et a très vite conquis la planète par sa simplicité d'utilisation et son côté prenant, alliant adresse et réflexion. Rappelons-en le principe.. ==> Lire en intégralité
mercredi 21 avril 2010
Bombes (P)03/2010 MyLzz59
(Rubrique VB-VBA)
0) Intro
A la fin du mois dernier, je vous proposais de me suivre pas à pas dans la réalisation d'un jeu en Visual Basic sous Excel, une feuille dans laquelle il fallait double-cliquer judicieusement sur des boules (enfin, des cases colorées) afin d'en supprimer le plus grand nombre.
J'ai réalisé ce p'tit jeu à la demande de notre fille, comme je l'ai précisé dans l'article correspondant. Un jeu sympathique, et fort simple à réaliser, dont la seule difficulté n'a rien de technique, c'est la compréhension de la notion de "récursivité".
Petit aparté à l'attention de celles et ceux à qui cette notion ne "parle" pas..
L'exemple incontournable lorsque l'on parle de "récursivité" est la fonction mathématique (nan, restez, n'ayez pas peur ) nommée "factorielle". Kêkseksa ?
La factorielle d'un nombre entier positif est le produit de tous les nombres entiers depuis 1 jusqu'à lui:
Factorielle(N) = N! = 1x2x3x4x...x(N-1)xN (simplement ça ).
Exemple: Factorielle(5) = 5! = 1x2x3x4x5 = 120
Certes, il n'est pas nécessaire de coder une récursivité pour résoudre une factorielle (sans utiliser la fonction intégrée )
N = Int(Abs(Val(InputBox("Nombre ?")))) ' N entier positif
F = 1 : For T = 1 To N : F = F * T : Next T
MsgBox "Facto(" + Cstr(N) + ") = " + Cstr(F) 
Cependant, réécrivons 5! et ..4!Factorielle(5) = 5! = 1x2x3x4x5 = 120
Factorielle(4) = 4! = 1x2x3x4 = 24
Sans avoir fait de hautes études mathématiques, il saute aux yeux que la factorielle de 5 est 5 fois la factorielle de 4. La "récursivité", c'est ça
Function Factorielle(ByVal N As Long) As Long If N<0 n="" or="">12 Then Factorielle = -1 : Exit Function ' Erreurs Factorielle = IIf(N>0, Factorielle(N-1) * N, 1) End FunctionComment ça marche ? Déjà un mot sur le bridage de N entre 0 et 12, car le résultat d'une factorielle "grimpe" vite, et 13! dépasse la capacité d'un entier long, c'est tout (oui, il existe d'autres formats..) Supposons que l'on demande Factorielle(5). La fonction s'exécute une première fois. Elle doit renvoyer Factorielle = Factorielle(5-1) * 5. VBA "met en attente" Factorielle(5), crée une nouvelle copie (appelée instance) de Factorielle, à laquelle il demande Factorielle(4), laquelle (idem) sera clônée pour calculer Factorielle(3), et ce jusqu'à Factorielle(0). Cette dernière renvoie la valeur 1 à Factorielle(1), qui peut finir son calcul et renvoyer son résultat (1) à Factorielle(2), etc.. Factorielle(4) qui renvoie 24 à Factorielle(5), laquelle nous répond son 120
1) Le Jeu
J'ai concocté un second jeu, basé sur (quasiment) la même feuille interface Excel, et dont l'objet ne sera pas une surprise, puisqu'il est mentionné dans l'article précédent, près de l'exemple de la factorielle car il utilise lui aussi une récursivité, il s'agit d'un ..Démineur
Rappel du principe: dans notre aire de jeu est dissimulée aléatoirement une certaine quantité de bombes. Le but du jeu est de toutes les retrouver, et les marquer d'un drapeau, sans en faire exploser une seule. Pour cela, l'utilisateur(trice) dispose de deux actions, mettre/enlever un drapeau, et dévoiler une case cachée. Dévoiler une bombe la fait exploser, et le jeu est terminé. Une case marquée d'un drapeau est "protégée". Le jeu est gagné lorsque soit exactement toutes les bombes ont été retrouvées, soit il ne reste plus de cases non dévoilées, excepté peut-être seulement des bombes.
Le départ du Démineur consiste à "taper" alétoirement, en espérant trouver une zone vierge de bombe, et non une bombe. Si la case dévoilée ne contient pas de bombe, elle fournit une indication sur la présence ou non de bombes: la quantité de bombes présentes dans les huit cases qui l'entourent (imaginer la case au centre d'un carré de 3 x 3 cases), quantité comprise entre 0 (non affiché) et 8 (le maximum si elle est cernée).
Dans notre Démineur nous allons utiliser les deux actions suivantes:
- le clic droit pour mettre/enlever un drapeau
- le double-clic pour dévoiler une case
Dévoiler une case contenant zéro bombe dévoilera automatiquement (voilà notre récursivité
Voilà, on a fait le tour, entrons
a] Le Décor
Comme mentionné plus haut, il s'agit de celui du jeu précédent (Boules), à la barre d'état près, car les deux cellules fusionnées des libellés des compteurs sont agrandies d'une case chacune, pour accueillir les nouveaux libellés. ===> Code du Décor ICI.
Même recommandation, ne sauvegardez PAS le classeur au format ".xlsX", au risque de perdre le code VBA !!
(Rem: n'hésitez pas à vous référer à l'article décrivant le jeu précédent, pour les explications communes que je ne reprendrai pas ici
2) Remplir l'Aire de Jeu
a] Définissons tout d'abord notre série de constantes en Zone Déclarations:
* Tit = "Bombes (P)03/2010 MyLzz59" => le titre du jeu
* Ym = 30, Xm = 40 => la taille (lignes, colonnes) de l'aire de jeu
* Nb = 100 => la quantité de bombes dissimulées, arbitraire
* Xt = 2 => abscisse de la cellule fusionnée du titre
* Xb = 18 => abscisse de la cellule fusionnée du nombre de bombes restantes
* Xc = 28 => abscisse de la cellule fusionnée du nombre de cases cachées
* Xr = 32 => abscisse de la cellule fusionnée du pseudo-bouton "Recommencer"
' ----------------- ' Zone Déclarations ' ----------------- Const Tit = "Bombes (P)03/2010 MyLzz59" Const Ym = 30, Xm = 40, Nb = 100, Xt = 2, Xb = 18, Xc = 28, Xr = 32b] Nettoyage de l'Aire de Jeu: il est identique à précédemment, excepté l'inscription de deux informations cachées sous la barre d'état, dans une zone non accessible de la feuille Excel, à savoir une chaîne texte qui mémorise le contenu réel de l'aire de jeu, et le vrai compteur de bombes non encore marquées, nous les détaillerons plus loin.
Notez au passage que la protection de la feuille est également présente, mais déplacée dans une procédure "Prot", car elle sera utile à différents endroits du code, ce qui évitera de la dupliquer inutilement:
' ------------------- ' SUB: Protéger (O/N) ' ------------------- Sub Prot(B As Boolean) If B Then Sheets(1).Protect "" Else Sheets(1).Unprotect "" End Subc] La boucle de remplissage. Nous allons employer ici un Tableau P(1 To Ym, 1 To Xm) de nombres entiers, similaire à l'aire de jeu. Au départ, toutes ses "cases" sont initialisées à zéro. La boucle (For T=) effectue les Nb (=100) placements de bombes, pour chaque l'on tire une "case" aléatoire (X=Int(Rnd*Xm)+1 et Y=Int(Rnd*Ym)+1) jusqu'à en trouver une qui ne soit déjà une bombe (Loop While)
Chacune de ces "cases" comptabilise le nombre de bombes qui l'entoure, concrètement de zéro (mini) à huit (maxi). Associons la notion de bombe à la valeur inutilisée neuf.
Parcourons le carré dont notre "case" est le centre. Dans les huit "cases" qui entourent la nôtre (si elles existent), incrémentons de un toutes les valeurs non bombes (non neuf).
La boucle de remplissage n'affiche rien dans l'aire de jeu.
' -----------------------
' Crée un Nouveau Terrain
' -----------------------
Sub Remplis()
Randomize Timer
Prot False
Cells(Ym + 5, 1).Value = "Z" + String$(Xm * Ym, "0")
Range(Cells(1, 1), Cells(Ym, Xm)).Interior.ColorIndex = 15
Range(Cells(1, 1), Cells(Ym, Xm)).ClearContents ' Nettoyage
For T = 1 To Nb
Do: Y = Int(Rnd * Ym) + 1: X = Int(Rnd * Xm) + 1: Loop While PP(Y, X) = 9 ' Bombes
For Y2 = Y - 1 To Y + 1: For X2 = X - 1 To X + 1
If X2 >= 1 And X2 <= Xm And Y2 >= 1 And Y2 <= Ym Then
If X2 <> X Or Y2 <> Y Then
If PP(Y2, X2) < 9 Then PP(Y2, X2) = PP(Y2, X2) + 1 ' Incrément autour
Else
PP(Y, X) = 9 ' Place Bombe
End If
End If
Next X2, Y2
Next T
Cells(Ym + 2, Xt).Value = Tit: Cells(Ym + 2, Xb).Value = Nb
Cells(Ym + 2, Xc).Value = Xm * Ym: Cells(Ym + 6, Xb).Value = Nb 'Marquages
Prot True: MsgBox "Bonne Chance ;)", vbInformation, Tit
End Subd] En fait, nous n'allons pas employer un Tableau P(1 To Ym, 1 To Xm) de nombres entiers (si, je sais ce que je dis Aussi, allons-nous simuler (
La procédure "Property Let" simule l'affectation d'une valeur à une pseudo-variable, alors que "Property Get" simule la relecture de la valeur de cette pseudo-variable. C'est pourquoi, dans le code ci-dessus, "PP(Y2, X2) = PP(Y2, X2) + 1" n'indique absolument pas que PP() n'est PAS le simple tableau annoncé en c]
' --------------------------------------------------------------------- ' Property Let: simule l'Ecriture de N [Integer] dans PP(Y,X) [Integer] ' --------------------------------------------------------------------- Property Let PP(ByVal Y As Integer, ByVal X As Integer, ByRef N As Integer) If X < 1 Or X > Xm Or Y < 1 Or Y > Ym Or N < 0 Or N > 9 Then Exit Property Z$ = Cells(Ym + 5, 1).Value Mid$(Z$, Xm * (Y - 1) + X + 1, 1) = CStr(N) Cells(Ym + 5, 1).Value = Z$ End Property ' --------------------------------------------------------------------- ' Property Get: simule la Lecture de N [Integer] dans PP(Y,X) [Integer] ' --------------------------------------------------------------------- Property Get PP(ByVal Y As Integer, ByVal X As Integer) As Integer If X < 1 Or X > Xm Or Y < 1 Or Y > Ym Or N < 0 Or N > 9 Then PP = -1: Exit Property PP = Val(Mid$(Cells(Ym + 5, 1).Value, Xm * (Y - 1) + X + 1, 1)) End PropertyRem: l'utilisation d'une Propriété n'était pas indispensable, et nous aurions pu nous "contenter" d'une Function Get_PP(ByVal Y As Integer, ByVal X As Integer) As Integer, et d'un Sub Let_PP(ByVal Y As Integer, ByVal X As Integer, ByRef N As Integer). Simplement je souhaitais introduire la propriété afin de garder une syntaxe d'utilisation similaire à celle d'un Tableau, alors qu'avec un Sub et une Function elle devient moins zolie
Tableau => P(Y2, X2) = P(Y2, X2) + 1
Property => PP(Y2, X2) = PP(Y2, X2) + 1
Sub/Fct => Let_PP Y2, X2, Get_PP(Y2, X2) + 1
3) Comment l'utilisateur(trice) joue..
a] Double-Click
Comme précédemment, nous allons intercepter le Double-Clic dans la Feuille, et substituer à la fonction d'édition de texte d'Excel l'appel de notre procédure d'ouverture de la case visée. La différence c'est que nous allons cette fois récupérer les coordonnées (Y,X) de la cellule grâce à Target. Nous retrouvons le "Cancel = True".
Le Double-Clic peut survenir dans l'aire de jeu, sur le bouton "Recommencer", ou ailleurs. Ailleurs, il ne se passera rien. Sur "Recommencer", une question proposera de réinitialiser le jeu en appelant "Remplis". Enfin, dans l'aire de jeu, nous invoquons un traitement récursif d'ouverture de la cellule, "Pop", que nous verrons plus loin, suivi d'une procédure (qui servira à deux reprises) vérifiant si le jeu est gagné, "TesteGagne". Ne pas oublier de déprotéger puis reprotéger la feuille..
' ------------------
' EVT: Teste la Zone
' ------------------
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Y = Target.Row: X = Target.Column: Cancel = True
If Y = Ym + 2 And X = Xr Then
If MsgBox("Réinitialiser l'Aire de Jeu ?", _
vbQuestion + vbYesNo + vbDefaultButton2, Tit) = vbYes Then Remplis
Exit Sub
End If
If X < 1 Or X > Xm Or Y < 1 Or Y > Ym Then Exit Sub
Prot False: Pop Y, X: TesteGagne: Prot True
End Subb] Right-ClickCe Jeu gère aussi une seconde action, le Clic Droit, afin de poser ou enlever les drapeaux sur les bombes supposées. VBA fournit ici aussi une procédure événementielle, "_BeforeRightClick", dont la syntaxe (imposée) est similaire à la précédente.
Le Clic Droit n'a d'effet que dans l'aire de jeu, et effectue une action fort simple: si la cellule (Target) est non dévoilée, alors on y place un drapeau, et l'on décrémente les compteurs de cases cachées et de bombes à trouver. Si la cellule contient un drapeau, alors on l'enlève au profit de l'état non dévoilé, et on incrémente les mêmes compteurs. Tout autre état de la cellule ne provoquera aucune action.
De la même façon, penser à déprotéger puis reprotéger la feuille, ainsi qu'à tester ensuite si le jeu est gagné.
Le moment est venu de vous parler du "vrai" compteur (caché) de bombes non encore marquées, qui n'est décrémenté que lorsque la case marquée d'un drapeau contient réellement une bombe (If PP(Y, X) = 9). Sachez déjà qu'il sert dans "TesteGagne", à détecter l'une des deux conditions permettant d'afficher "Gagné" sans obliger l'utilisateur(trice) à cliquer (double ou droit) la totalité de l'aire de jeu
' ------------
' EVT: Drapeau
' ------------
Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean)
Y = Target.Row: X = Target.Column: If X < 1 Or X > Xm Or Y < 1 Or Y > Ym Then Exit Sub
Select Case Target.Text
Case "": T = 10: T2 = -1: GoSub SS1
Case "O": T = 11: T2 = 1: GoSub SS1
End Select
Cancel = True: Exit Sub
SS1: Prot False: Colorie Y, X, 1 * T: Cells(Ym + 2, Xb) = Cells(Ym + 2, Xb) + T2
If PP(Y, X) = 9 Then Cells(Ym + 6, Xb) = Cells(Ym + 6, Xb) + T2
Cells(Ym + 2, Xc) = Cells(Ym + 2, Xc) + T2: TesteGagne: Prot True: Return
End Subc] Le Coloriage des CellulesC'est la procédure dédiée "Colorie" qui va s'en charger. Nous allons lui fournir les coordonnées de la cellule, et ..un nombre entier représentant l'état à afficher:
* 0 => cellule dévoilée vierge de bombe (gris foncé)
* 1 à 8 => cellule dévoilée entourée d'une à huit bombes
* 9 => dévoiler une bombe (un "M" en police WingDings)
* 10 => afficher un drapeau (un "O" en police WingDings)
* 11 => remettre la cellule à l'état caché (supprimer le drapeau)
* 12 => comme 0, mais verte (pour l'état Gagné)
* 13 => comme 0, mais rouge (pour l'état Perdu)
Cette procédure modifie le contenu de la cellule (.Value), la police utilisée (.Font.Name), la couleur de la police (.Font.ColorIndex), et celle du fond de la cellule (.Interior.ColorIndex). L'usage du ColorIndex plutôt que Color rend compatibles les couleurs du jeu avec les versions antérieures à 2007..
' -----------------------------------------------------------------------------
' Sub: Colorie la Case (Y,X) en Fonction du Nombre de Bombes (ou autre..)
' ( N=0..8 ; N=9:Bombe ; N=10:Drapeau ; N=11:Cachée ; N=12:Gagné ; N=13:Perdu )
' -----------------------------------------------------------------------------
Sub Colorie(ByVal Y As Integer, ByVal X As Integer, ByRef N As Integer)
If X < 1 Or X > Xm Or Y < 1 Or Y > Ym Or N < 0 Or N > 13 Then Exit Sub
With Cells(Y, X)
.Interior.ColorIndex = IIf(N = 13, 30, IIf(N = 12, 10, _
IIf(N = 11, 15, IIf(N = 10, 19, IIf(N = 9, 3, IIf(N, 17, 16))))))
.Font.ColorIndex = IIf(N = 13, 30, IIf(N = 12, 10, _
IIf(N = 11, 11, IIf(N = 10, 11, IIf(N = 9, 1, IIf(N, 8, 16))))))
.Font.Name = IIf(N > 8 And N < 11, "Wingdings", "Comic Sans")
.Value = IIf(N > 11, "0", IIf(N = 11, "", IIf(N = 10, "O", IIf(N = 9, "M", CStr(N)))))
End With
End Sub4) L'ouverture de la cellule ("Pop")Cette procédure aura pour missions
- de découvrir la case visée
- de gérer le "Perdu" en cas de découverte d'une bombe
- d'ouvrir (en récursif) toute la zone contiguë de zéro bombe
Tout d'abord "Pop" va s'assurer que la cellule visée est dans l'aire de jeu, et qu'elle est non découverte. Entre autres pour protéger de l'explosion une bombe marquée d'un drapeau.
Si tout va bien, après avoir décrémenté le compteur de cases couvertes, intéressons-nous au contenu de la case visée, que l'on aura dévoilée.
* Si elle contient une bombe, le jeu est perdu, il doit s'arrêter. Le plus simple reste de découvrir toutes les cases restantes. Il faut aussi découvrir la bombe. Pourquoi ne pas découvrir toutes les bombes, même celles marquées d'un drapeau ?
If Cells(Y, X).Text = "" Or Cells(Y, X).Text = "O" Then Colorie Y, X, PP(Y, X)Puis, pour matérialiser que le jeu est perdu, re-colorions en rouge (Colorie ,,13) toutes les cases zéro bombe.
If Cells(Y, X).Text = "0" Then Colorie Y, X, 13* Si elle contient une des indications "1" à "8", tout est déjà fait.
* Si elle contient zéro, nous allons dégainer notre récursivité
' ----------------------------------
' SUB: Découvrir une Case (Récursif)
' ----------------------------------
Sub Pop(ByVal Y As Integer, ByVal X As Integer)
If X < 1 Or X > Xm Or Y < 1 Or Y > Ym Then Exit Sub
If Cells(Y, X).Text <> "" Then Exit Sub
Colorie Y, X, PP(Y, X): Cells(Ym + 2, Xc) = Cells(Ym + 2, Xc) - 1
Select Case PP(Y, X)
Case 9 ' Bombe
For Y = 1 To Ym: For X = 1 To Xm
If Cells(Y, X).Text = "" _
Or Cells(Y, X).Text = "O" Then Colorie Y, X, PP(Y, X)
If Cells(Y, X).Text = "0" Then Colorie Y, X, 13
Next X, Y
MsgBox "<<<< BOOM >>>>" + vbCrLf + vbCrLf + "Vous avez perdu.. :(", vbCritical, Tit
Case 1 To 8 ' Découvrir
Case 0 ' Découvrir en Récursif
For Y2 = Y - 1 To Y + 1: For X2 = X - 1 To X + 1
If X2 >= 1 And X2 <= Xm And Y2 >= 1 And Y2 <= Ym Then
If Cells(Y2, X2).Text = "" Then Pop Y2, X2
End If
Next X2, Y2
End Select
End Sub5) La détection de l'état Gagné ("TesteGagne")Voici la dernière étape de ce jeu, celle qui sera appelée après chacune des deux actions de l'utilisateur(trice), pour mémoire le double-clic ou le clic droit, la procédure qui vérifie si le jeu est gagné. La première idée qui vient à l'esprit, c'est de considérer comme gagné un jeu dans lequel il ne reste plus aucune case jouable, et exactement autant de drapeaux que de bombes. Certes, mais quel(le) joueur(se) trouverait amusant de devoir terminer de cliquer partout, une fois les bombes toutes trouvées ? Déjà pas moi
Aussi, je vous propose deux autres conditions de fin sur Gagné, basées sur nos trois compteurs disponibles. Rappel de nos compteurs:
* cases couvertes: démarre à (Xm x Ym), décrémenté à chaque case découverte, décrémenté à la pose d'un drapeau, ré-incrémenté à la suppression d'un drapeau.
* bombes restantes (visible): démarre à Nb, décrémenté à la pose d'un drapeau, ré-incrémenté à la suppression d'un drapeau, indépendamment du contenu réel de la case couverte.
* bombes réelles (caché): démarre à Nb, décrémenté à la pose d'un drapeau, ré-incrémenté à la suppression d'un drapeau, uniquement si la case couverte contient une bombe.
Condition 1: l'utilisateur(trice) a placé des drapeaux sur toutes les bombes, et nulle part ailleurs, les cases restantes ne sont plus que des cases sans bombe => les compteurs bombes restantes (visible) et bombes réelles (caché) sont tous deux à zéro.
Condition 2: l'utilisateur(trice) a dévoilé toutes les cases sauf des bombes (drapeaux ou pas) => cases couvertes = bombes restantes (visible).
Si l'une ou l'autre de ces conditions est vérifiée le jeu passera à l'état Gagné (et doit s'arrêter), nous allons découvrir toutes les cases restantes et re-colorions en vert (Colorie ,,12) toutes les cases zéro bombe (cf. Perdu)
' --------------
' Sub TesteGagne
' --------------
Sub TesteGagne()
If Cells(Ym + 2, Xb).Value = Cells(Ym + 2, Xc).Value Or _
(Cells(Ym + 2, Xb).Value = 0 And Cells(Ym + 6, Xb).Value = 0) Then
For Y = 1 To Ym: For X = 1 To Xm
'If Cells(Y, X).Text = "" _
or Cells(Y, X).Text = "O" Then Colorie Y, X, P(Y, X)
If Cells(Y, X).Text = "" _
Or Cells(Y, X).Text = "O" Then Colorie Y, X, PP(Y, X)
If Cells(Y, X).Text = "0" Then Colorie Y, X, 12
Next X, Y
MsgBox "<<<< BRAVO >>>>" + vbCrLf + vbCrLf + "Vous avez gagné.. :)", vbInformation, Tit
End If
End SubLe Code Complet de ce Jeu est disponible ICI..-MyLzz59-
mardi 23 mars 2010
Boules (P)03/2010 MyLzz59
(Rubrique VB-VBA)
0) Intro
Il y a quelques jours, notre Miss me faisait remarquer qu'il y avait longtemps que je ne lui avais pas conçu de programme.. Il n'en fallait pas plus pour titiller la "pianiste" que je suis, et je me suis mise en quête d'une idée de petit jeu susceptible d'intéresser la Miss, avec pour autre contrainte son développement en VBA sous Word ou Excel.
Tss.. J'entends d'ici les critiques et quolibets d'autres "vrais pianistes" (ou se définissant comme tels): "Visual Basic, elle.. Ben voyons, c'est un langage antédiluvien qui date d'au moins ..une décennie () ! De nos jours on développe en Java J-Truc-Truc-Machin-Chose version quarante-douze point kêk-chose aussi.. ou au pire en Dot Net 10, ma bonne dame !" Re-Tss..
Ben oui, mon langage préféré a toujours été le BASIC, et la version que j'affectionne est Visual Basic 6, la dernière non-dot-net. Certes, entre temps, 4 nouvelles versions de Basic "Dot Net" ont vu le jour, et l'on pourrait croire VB6 définitivement mort et enterré. C'est vrai et c'est faux. VB6 en tant que langage autonome l'est, Microsoft n'en assurant même plus le suivi depuis lurette, mais VB6 a "enfanté" deux ersatz toujours en vie, VBA (Visual Basic pour Applications), et VBS (VB Script). VBS est plutôt dédié personnalisations de machines, il n'a pas d'environnement éditeur, pas de débogueur (correcteur), ses programmes s'écrivent directement dans des fichiers texte non compilés, on ne peut y créer de réelle interface, etc..
Venons-en à VBA. VBA dispose d'un environnement éditeur assez semblable à (feu) VB6, il sait créer des fenêtres Windows, dispose d'un puissant débogueur, celui qu'avait VB6, et permet prendre un contrôle quasi total sur ses hôtes, à l'intérieur desquels il est "caché". VBA "habite", peut-être encore à votre insu, dans des logiciels que vous utilisez probablement couramment au travail, à savoir la suite Office (Word, Excel, Powerpoint, Access..) et quelques produits tiers ayant acheté la licence (Crystal Reports..) VBA est faussement appelé "éditeur de macros", dont il a pris la succession depuis Office 97, existe toujours dans Office 2007 (PC), est réintégré dans Office 2008 (Mac), et devrait cohabiter en standard avec une version optionnelle dérivée de VB.Net dans Office 2010 (à confirmer). Bref..
1) Le Jeu
Peut-être connaissez-vous ce jeu, assez répandu sur les pda et gsm, où il faut supprimer judicieusement des boules empilées, lorsqu'elles sont au minimum trois jointives de même couleur, afin d'en garder en fin de partie le moins possible ? Voici donc le jeu retenu. Un jeu de logique et de hasard, prenant, et somme toute simple à programmer
L'hôte qui se prête le mieux à cette réalisation est Excel, car il gère déjà un empilement ..de cellules Dans ma réalisation, à la place de boules (ce serait cependant aisément modifiable, qui s'y colle ?) j'ai opté pour des cases colorées. Une aire de jeu de 40 colonnes sur 30 lignes, et une barre d'état au-dessous, le tout dans une feuille d'Excel.
Nous allons d'abord planter le décor (o gué, o gué ). Alors que le reste de la feuille est caché, l'aire de jeu s'installe dans la partie fixe des volets. La taille d'une cellule de jeu est de 20x19 pixels. Le choix des couleurs le rend compatible avec les versions d'Excel antérieures à 2007. Afin de vous ôter
vos complexes (o gué, o gué cette )
chiante pénible tâche qui d'ailleurs n'apporte rien sur le plan technique (sauf peut-être de chercher dans 2007 où ils ont planqué les fonctions que vous connaissiez ), je vous ai concocté un bout de code qui bâtit l'interface pour vous. Allez le récupérer ICI, démarrez Excel avec un classeur vierge, appelez l'éditeur VBA (Alt-F11
), double-cliquez dans l'Explorateur de Projets VBA (menu Affichage, s'il n'est pas présent) sur la première Feuille du classeur, collez-y le bout de code, et exécutez-le (l'icône Triangle, ou la touche F5
). Sauvegardez votre classeur au format ".xls" ou ".xlsM" mais surtout pas ".xlsX" !!
Si vous avez obtenu l'équivalent de l'image ci-dessus, alors tout va bien, vous pouvez vous débarrasser du bout de code, il ne servira plus..
2) Remplir l'Aire de Jeu
a] Pour faciliter le redimensionnement éventuel du jeu et éviter les redites, commençons par définir une série de constantes, en Zone Déclarations afin de les rendre accessibles de toutes les procédures à venir:
* Tit = "Boules (P)03/2010 MyLzz59" => le titre du jeu
* Ym = 30, Xm = 40 => la taille (lignes, colonnes) de l'aire de jeu
* Nm = 900 => la quantité de boules au départ, arbitraire à 3/4 de l'aire
* Xt = 2 => abscisse de la cellule fusionnée du titre
* Xb = 18 => abscisse de la cellule fusionnée du nombre de pions restants
* Xc = 27 => abscisse de la cellule fusionnée du nombre de coups joués
* Xr = 32 => abscisse de la cellule fusionnée du pseudo-bouton "Recommencer"
' -----------------b] Nettoyage de l'Aire de Jeu: remplissons le fond des cases par un gris moyen (Interior.ColorIndex=15), et effaçons-en l'éventuel contenu texte (ClearContents). Ecrivons également en ligne d'état le titre (Tit), le nombre de boules (Nm=900), et le nombre de coups joués (zéro).
' Zone Déclarations
' -----------------
Const Tit = "Boules (P)03/2010 MyLzz59"
Const Ym = 30, Xm = 40, Nm = 900, Xt = 2, Xb = 18, Xc = 27, Xr = 32
Notez au passage que la feuille est protégée (sans mot de passe) afin de ne permetre aucune modification (volontaire ou non) de l'utilisateur(trice), qui ne peut que sélectionner les cellules, toutes verrouillées..
c] La boucle de remplissage. Un tableau P(1 To Xm) de 40 nombres entiers est destiné à mémoriser combien de boules ont déjà été mises dans chacune des 40 colonnes de l'aire, afin de ne pas les remplir (aléatoirement) au-delà de leur capacité (Ym=30). La boucle (For T=) effectue les Nm (=900) placements, pour chaque l'on tire une colonne aléatoire (X=Int(Rnd*Xm)+1) entre 1 et 40 jusqu'à en trouver une qui ne soit déjà remplie (Loop While). Dans cette colonne X, à la bonne altitude (Ym-P(X)) l'on colorie la case aléatoirement (Interior.ColorIndex=Int(Rnd*4)+3) avec l'une des 4 couleurs suivantes: rouge (ColorIndex=3), vert (ColorIndex=4), bleu (ColorIndex=5), ou jaune (ColorIndex=6). Pensez à incrémenter P(X)
' -------------------------Vous pouvez d'ores et déjà tester le remplissage depuis l'éditeur VBA: collez la Zone Déclarations et le Sub Remplis dans la première feuille (la seule restante) du classeur (dans VBA
' Crée un Nouvel Empilement
' -------------------------
Sub Remplis()
Dim P(1 To Xm) As Integer
Randomize Timer
Sheets(1).Unprotect ""
Range(Cells(1, 1), Cells(Ym, Xm)).Interior.ColorIndex = 15
Range(Cells(1, 1), Cells(Ym, Xm)).ClearContents
For T = 1 To Nm
Do: X = Int(Rnd * Xm) + 1: Loop While P(X) = Ym
Cells(Ym - P(X), X).Interior.ColorIndex = Int(Rnd * 4) + 3
P(X) = P(X) + 1
Next T
Cells(Ym + 2, Xt).Value = Tit
Cells(Ym + 2, Xb).Value = Nm: Cells(Ym + 2, Xc).Value = 0
Sheets(1).Protect ""
End Sub
3) Comment l'utilisateur(trice) joue..
Le plus facile, c'est de le(la) faire double-cliquer sur une cellule. Le double-clic élimine la possibilité d'une sélection multiple. VBA gère la récupération du double-clic au travers d'une procédure dite "événementielle", nommée "_BeforeDoubleClick", dont la syntaxe est imposée. Utilisez les deux zones déroulantes au-dessus du code pour la générer. Ce corps de procédure vous fournit (Target) la cellule visée (inutilisée ici), ainsi qu'un moyen de bloquer la fonction automatique d'Excel (l'édition du texte) associée au double-clic d'une cellule: forcer Cancel à Vrai (True)
Nous ne mettrons dans cet événement que l'appel de la procédure d'identification de la forme (voir ci-après), et le "Cancel=True"..
Rem: le ":" en début de ligne est indispensable, sinon VBA confondrait "Forme" avec une étiquette de ligne, vu que le Sub Forme n'a pas de paramètre !!
' -------------------------------------4) Détecter la forme visée par l'utilisateur(trice)
' EVT: Supprime la Forme Double-Cliquée
' -------------------------------------
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
: Forme: Cancel = True
End Sub
Ce(tte) dernier(ère) a double-cliqué dans une cellule, dont on récupère les coordonnées ligne (ActiveCell.Row) et colonne (ActiveCell.Column). Cette cellule peut appartenir aux éléments suivants: une boule (son code couleur est compris entre 3 et 6), le fond de l'aire
a] Principe de détection (attention, c'est là le point compliqué
Définissons un compteur numérique, initialisé à zéro. Créons une procédure "Tagge" à laquelle on passe les coordonnées X et Y de la cellule visée, ainsi que notre compteur. Si la cellule est dans l'aire, contient un code couleur associé à une boule (que l'on mémorise temporairement dans Static C), et n'a pas été marquée d'un texte, marquons-la du texte "*" (pour ne pas la compter plusieurs fois), et incrémentons notre compteur N de 1.
Procédons de même pour les 4 cellules adjacentes (dessus, dessous, gauche, et droite), en ..invoquant de façon récursive notre procédure Tagge (
Notez que ce procédé (récursivité) se retrouve par exemple dans le jeu du Démineur ("ouverture" des zones de zéro bombe), ou dans le calcul mathématique "cas d'école" de la Factorielle
Au sortir de ces appels récursifs, notre compteur N reporte la quantité de cellules marquées d'une "*". Si elle est supérieure ou égale à 3, nous allons lancer une procédure de suppression de la forme (ainsi que mettre à jour les compteurs de boules et de coups joués), sinon juste effacer les marquages (sans incrémenter le compteur de coups
b] Le pseudo-bouton "Recommencer"
Nous allons nous occuper de lui par la même occasion, via la même procédure "Tagge", qui renverra alors N=-1 sans tenter de récursivité. Au sortir de l'appel de "Tagge", l'on testera donc 3 cas: (N>=3) suppression de la forme, puis (N>-1) effacement des "*", sinon ne rien faire (l'appel de "Remplis" est déjà dans "Tagge", au bout d'une question de confirmation (If MsgBox()) ).
Notez que "Forme" (tout comme "Remplis") ôte puis remet la protection de la feuille..
' ------------------------5) Suppression de la forme
' Traite la Forme Désignée
' ------------------------
Sub Forme()
Dim N As Integer
Sheets(1).Unprotect ""
N = 0: Tagge ActiveCell.Row, ActiveCell.Column, N: DoEvents
If N >= 3 Then
Cells(Ym + 2, Xb).Value = Cells(Ym + 2, Xb).Value - N
Cells(Ym + 2, Xc).Value = Cells(Ym + 2, Xc).Value + 1: Supprime
Else
If N > -1 Then Range(Cells(1, 1), Cells(Ym, Xm)).ClearContents
End If
Range("A1").Select: DoEvents
Sheets(1).Protect ""
End Sub
' -------------------
' (utilisé par Forme)
' -------------------
Sub Tagge(ByVal Y As Integer, ByVal X As Integer, ByRef N As Integer)
If X < 1 Or X > Xm Or Y < 1 Or (Y > Ym And Y <> Ym + 2) Then Exit Sub
If Y = Ym + 2 Then
' Menu
N = -1: If X = Xr Then If MsgBox("Réinitialiser l'Aire de Jeu ?", _
vbQuestion + vbYesNo + vbDefaultButton2, Tit) = vbYes Then Remplis
Else
' Zone de Jeu
Static C
With Cells(Y, X)
If N = 0 Then C = .Interior.ColorIndex: If C > 8 Then Exit Sub
If .Text = "" And .Interior.ColorIndex = C Then
.Value = "*": N = N + 1
For T2 = Y - 1 To Y + 1 Step 2: Tagge T2, X, N: Next T2
For T1 = X - 1 To X + 1 Step 2: Tagge Y, T1, N: Next T1
End If
End With
End If
End Sub
Celle-ci a lieu en deux temps: d'abord nous allons scanner chaque colonne à la recherche d'une "*". S'il y en a une, nous allons effectuer un couper-coller de la zone d'aire située au-dessus d'elle, afin de la descendre d'une ligne, ce qui "écrase" la boule marquée. Pensez à réinitialiser la cellule tout en haut (ligne 1) en "fond" (ColorIndex=15 et pas de texte). Pensez aussi à retester l'emplacement où était la boule supprimée
Puis, une fois la colonne traitée, l'on teste si elle contient encore une boule (tout en bas
' ------------------------Le Code Complet de ce Jeu est disponible ICI..
' Supprime la Forme Taggée
' ------------------------
Sub Supprime()
For X = 1 To Xm
' Colonne
For Y = Ym To 1 Step -1
If Cells(Y, X).Text <> "" Then
If Y > 1 Then
Range(Cells(1, X), Cells(Y - 1, X)).Copy
Range(Cells(2, X), Cells(Y, X)).PasteSpecial xlPasteAll
End If
Cells(1, X).Interior.ColorIndex = 15
Cells(1, X).Value = "": Y = Y + 1
End If
Next Y
' Ligne
If X < Xm And Cells(Ym, X).Interior.ColorIndex = 15 Then
Range(Cells(1, X + 1), Cells(Ym, Xm)).Copy
Range(Cells(1, X), Cells(Ym, Xm - 1)).PasteSpecial xlPasteAll
Range(Cells(1, Xm), Cells(Ym, Xm)).Interior.ColorIndex = 15
Range(Cells(1, Xm), Cells(Ym, Xm)).ClearContents
If Cells(Ym, X).Interior.ColorIndex <> 15 Then X = X - 1
End If
Next X
End Sub
-MyLzz59-
mercredi 1 juillet 2009
DigiClock sous Word
.
Présentation
Dans la même veine (la même inutilité ?) que la précédente (que je vous invite à relire tant elles se ressemblent), voici toujours sous Word, et avec des Segments, une Horloge ..Numérique, aussi appelée "7 Segments".
Si vous êtes pressé(e)s de la voir à l'oeuvre, vous pouvez commencer par l'intégrer à un nouveau document, et vous préoccuper des explications ultérieurement. Sinon, elles figurent sous ce code..
Le Code
Démarrez Word (version 2000 ou supérieure), ouvrez un nouveau document (vierge), et lancez l'éditeur VBA via le menu Outils > Macros, ou les touches Alt-F11. Repérez (ou affichez) l'explorateur de projets, et double-cliquez sur "ThisDocument". Ceci ouvre une fenêtre de code "ThisDocument (Code)". Effacez les lignes qui s'y trouveraient éventuellement, et collez le code ci-dessous.
Enregistrez (l'icône disquette ou Ctrl-S) le document, refermez l'éditeur VBA, ainsi que le document sauvegardé. Vérifiez au besoin (menu Outils > Macros > Sécurité) que le niveau de sécurité des macros ne soit pas sur "haut". Rouvrez le document, le code devrait démarrer, moyennant peut-être de valider "Activer les macros"..
' -----------------
' Zone Déclarations
' -----------------
Dim TD As Document
' ---------------------
' SUB: Horloge Digitale
' ---------------------
Private Sub Document_Open()
' Nettoyage
Set TD = ThisDocument
TD.Content.Delete
' Création des Chiffres ("L01" à "L42")
N = 0: X0 = 16: Y0 = 70
Z0$ = "1,0;3,0;4,1;4,3;4,5;4,7;3,8;1,8;0,7;0,5;0,3;0,1;1,4;3,4;"
For T = 1 To 6
Z$ = Z0$: X0 = X0 + 64 + 16 * (T Mod 2): GoSub SS1
Next T
' Création des Points ("L43" to "L46")
For X0 = 220 To 364 Step 144
Z$ = "0,2;0,3;0,5;0,6;": GoSub SS1
Next X0
' Boucle Infinie
Do
' Attente
Do: K$ = Time$: DoEvents: Loop While K$ = K0$: K0$ = K$
' Décryptage
For T = 1 To 6
V0 = Val(Mid$(K$, Int(1.4 * T), 1)): N = 7 * T - 6
V = V0 <> 1 And V0 <> 4: GoSub SS2
V = V0 < 5 Or V0 > 6: GoSub SS2
V = V0 <> 2: GoSub SS2
V = (V0 Mod 3) <> 1: GoSub SS2
V = (V0 Mod 2) = 0 And V0 <> 4: GoSub SS2
V = V0 = 0 Or (V0 > 3 And V0 <> 7): GoSub SS2
V = V0 > 1 And V0 <> 7: GoSub SS2
Next T
DoEvents
Loop
Exit Sub
' SSUB: Ajout Segments
SS1:
While Z$ <> ""
T1 = InStr(Z$, ","): T2 = InStr(T1 + 1, Z$, ";")
T3 = InStr(T2 + 1, Z$, ","): T4 = InStr(T3 + 1, Z$, ";")
N = N + 1: Z2$ = "L" + Format$(N, "00")
TD.Shapes.AddLine( _
X0 + 10 * Val(Left$(Z$, T1 - 1)), _
Y0 + 10 * Val(Mid$(Z$, T1 + 1, T2 - T1 - 1)), _
X0 + 10 * Val(Mid$(Z$, T2 + 1, T3 - T2 - 1)), _
Y0 + 10 * Val(Mid$(Z$, T3 + 1, T4 - T3 - 1)) _
).Name = Z2$
Z$ = Mid$(Z$, T4 + 1)
TD.Shapes(Z2$).Line.Weight = 11
TD.Shapes(Z2$).Line.ForeColor = &H800000
Wend
Return
' SSUB: Etat d'un Segment
SS2: TD.Shapes("L" + Format$(N, "00")).Visible _
= IIf(V, msoTrue, msoFalse): N = N + 1
Return
End Sub
Explications
Nous ne nous attarderons pas sur la création-même des Segments, ils ont été détaillés précédemment. Notez qu'ici la façon de les créer est "pilotée" par la chaîne Z$. Pour chacun des 6 Chiffres, la même séquence sera répétée.
En observant Z$, une séquence s'y reproduit, c'est "X,Y;". Pris séquentiellement par deux, ces Points (X,Y) serviront à créer et positionner les segments de chaque chiffre dans un ordre précis. Accessoirement, ces segments seront nommés également séquentiellement, pour le premier chiffre (dizaines d'heures) de "L01" à "L07", le second de "L08" à "L14", etc.. jusqu'au sixième (unités de secondes) de "L36" à "L42". Cette numérotation permet d'adresser un segment par deux paramètres: la position du chiffre, et la position du segment dans le chiffre.
La même méthode de construction est appliquée pour la création des deux paires de points ("L43" à "L46").
La boucle infinie, ainsi que la boucle d'acquisition de l'heure sont les mêmes que dans l'horloge précédente, à ce détail près: nous allons récupérer l'heure non pas via le Timer, mais la fonction Texte Time$(), plus adaptée ici, d'autant que nous n'utiliserons pas de centièmes pour faire clignoter les deux deux-points. Time$() renvoie une chaîne de 8 caractères selon ce motif: "hh:mm:ss". Une formule simple permet de transformer {1;2;3;4;5;6} et {1;2;4;5;7;8} afin d'éliminer les deux-points..
Reste la partie la plus intéressante, la conversion d'un chiffre de 0 à 9 en l'allumage ou l'extinction des 7 segments qui stylisent ce chiffre. Dressons le tableau..
| 0 | 1 | 2 | 3 | 4 | 5 | 6 | 7 | 8 | 9 | |
| L01 | # | # | # | # | # | # | # | # | ||
| L02 | # | # | # | # | # | # | # | # | ||
| L03 | # | # | # | # | # | # | # | # | # | |
| L04 | # | # | # | # | # | # | # | |||
| L05 | # | # | # | # | ||||||
| L06 | # | # | # | # | # | # | ||||
| L07 | # | # | # | # | # | # | # | |||
Il suffit alors de relire ce tableau, d'abord en français, puis en code..
(V0 est la valeur du chiffre, et V l'état allumé/éteint résultant)
L01 s'allume pour les valeurs autres que 1 et 4
=> V = V0 <> 1 And V0 <> 4
L02 s'allume si la valeur est inférieure à 5 ou supérieure à 6
=> V = V0 < 5 Or V0 > 6
L03 s'allume si la valeur est différente de 2
=> V = V0 <> 2
L04 s'allume pour toute valeur dont le reste de la division entière par 3 n'est pas 1
=> V = (V0 Mod 3) <> 1
..et ainsi de suite (essayez avec les 3 segments restants) !
Dernière chose: les DoEvents permettent de rendre du temps CPU au système lorsque le programme n'en requiert pas 100%, par exemple pour ..rafraîchir l'affichage :)
-MyLzz59-