JEU - Qui veut gagner des millions ?

Bonsoir !

Pour les cours de programmation, je dois développer un jeu au choix en VBA. J'ai choisi de créer le jeu "Qui veut gagner des millions ?", jusqu'ici tout marche ! J'ai réussi à faire apparaître les questions et les réponses où je veux ...

Cependant, les choses se corsent par la suite ... Je ne sais pas comment faire ces 3 choses :

  • Dans la pyramide des gains, surligner la case pour savoir à quel niveau (ou à quelle question) on se trouve
  • Faire en sorte que lorsque l'on donne une mauvaise réponse, on redescende au palier d'en dessous (en orange sur la pyramide des gains) avec un message qui affiche "Ce n'est pas grave, vous repartez tout de même avec la somme de xxxxx euros !"
  • Créer le joker qui enlève 2 mauvaises réponses et qui n'est utilisable qu'une seule fois

Si vous pourriez m'aider, ce serait gentil !

Merci beaucoup à ceux qui répondront à mon message

Bonsoir,

les photos c'est bien !

mais il est dur de travailler le code !!!

Le fichier joint serait la bienvenue, non ?

@ bientôt

LouReeD

Tout d'abord merci de m'avoir répondu, et voici le fichier !

Bonsoir,

je me suis permis quelque modif...

Le niveau en fonction de la question fonctionne,

Les boutons réponses ont disparus... il suffit de cliquer sur la bonne réponse

La gestion des erreur n'est pas faite

donc l'affichage des gains gagnés n'est pas fait

Par soucis de taille j'ai supprimé quelques photos...

Ceci dit si c'est un exercice ne copiez pas trop, mais essayez de comprendre

@ bientôt

LouReeD

97qvgdm-loureed.xlsm (39.22 Ko)

Merci beaucoup de m'aider

Effectivement, c'est beaucoup plus épuré sans les boutons, merci

J'aimerais que le programme affiche "Perdu ! Vous avez gagné xxxx euros" si la personne redescend au palier orange (1 500€ ou 48 000€). Ou, si elle perd à 800€, qu'il y ait marqué "Perdu !" tout court.

Je pensais utiliser une Msgbox mais je me rends compte que ça ne suffirait pas. Comment puis-je faire ?

Bonsoir,

Je cherche dans les petits espace de temps libre qu'il me reste en fin de journée...

Ceci dit j'aime bien votre jeu !

Mais la fonction randomize est à revoir ou modifier car j'ai l'impression que les questions de la première partie (ouverture du fichier) sont les mêmes... A voir

@ bientôt

LouReeD

D'accord, je cherche de mon côté mais pour l'instant je ne trouve pas le moyen de faire comprendre au programme que je veux qu'il retourne à la somme du palier orange (1500€ ou 48 000€) si le joueur répond mal à une question au dessus de ces mêmes paliers !

Merci de m'aider en tout cas

Oui je pense aussi que c'est un bon sujet comme jeu !

Une idée : j'ai créé une variable rang...

si perdu et :

si rang > ou égal à 7 alors 48 000

ou si rang > ou égal à 2 alors 1 500

alors perdu

si gagne alors 1 000 000 !!!!

@ bientôt

LouReeD

Ah oui je comprends l'idée ! Comment cette variable fonctionne t-elle au juste ?

Voilà le code rattaché à la feuille sur une procédure de surveillance événementielle qui nous détecte le clic sur les cellules réponses :

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Application.EnableEvents = False
If Not Intersect(Target, Range("F18:H19,K18:M19,F22:H23,K22:M23")) Is Nothing Then

    If Not Intersect(Target, Range("F18:H19")) Is Nothing Then
        If Worksheets("Questions-réponses").Cells(x, 6 + (6 * (rang - 1))) = "A" Then
        MsgBox ("Bien joué ! Vous passez à la question suivante !")
        rang = rang + 1
        Call tirage_question(rang)
        End If
    End If
    If Not Intersect(Target, Range("K18:M19")) Is Nothing Then
        If Worksheets("Questions-réponses").Cells(x, 6 + (6 * (rang - 1))) = "B" Then
        MsgBox ("Bien joué ! Vous passez à la question suivante !")
        rang = rang + 1
        Call tirage_question(rang)
        End If
    End If
    If Not Intersect(Target, Range("F22:H23")) Is Nothing Then
        If Worksheets("Questions-réponses").Cells(x, 6 + (6 * (rang - 1))) = "C" Then
        MsgBox ("Bien joué ! Vous passez à la question suivante !")
        rang = rang + 1
        Call tirage_question(rang)
        End If
    End If
    If Not Intersect(Target, Range("K22:M23")) Is Nothing Then
        If Worksheets("Questions-réponses").Cells(x, 6 + (6 * (rang - 1))) = "D" Then
        MsgBox ("Bien joué ! Vous passez à la question suivante !")
        rang = rang + 1
        Call tirage_question(rang)
        End If
    End If
End If
ActiveSheet.Cells(1, 1).Activate
Application.EnableEvents = True
End Sub

A chaque bonne réponse la variable rang est incrémentée de 1

cette partie de code est à modifier car seul les bonnes réponses sont gérées :

 If Worksheets("Questions-réponses").Cells(x, 6 + (6 * (rang - 1))) = "C" Then

ici pour la bonne réponse C.

il reste à gérer le rang 12 avec bonne réponse (1 000 000)

ActiveSheet.Cells(1, 1).Activate

cette ligne permet "de sortir" des cellule de réponse afin de détecter le changement de sélection et vérifier si c'est une des quatre cellule de réponse.

Pour voir le code, un clic droit sur le nom de l'onglet 'Jeu"

puis "visualiser le code" et vous tomber dessus...

@ bientôt

LouReeD

Une petite erreur dans le test !

ce n'est pas >= à 7 ou >=2

>7 et >2 en effet faut valider le palier pour le gagner donc être au rang supérieur !

Ci-joint le fichier

@ bientôt

LouReeD

36qvgdm-loureed.xlsm (39.06 Ko)

Merci c'est très gentil de passer autant de temps à m'aider

Donc finalement, à part pour le changement de couleur, toute cette partie du code peut remplacer le code déjà contenu dans la feuille si je comprends bien ?

Je vois à peu près comment fonctionne la variable rang, il faudrait ajouter un "Else" avec une conséquence Msgbox ("Vous avez perdu !") si on perd à 800€, mais une Msgbox ("Vous avez perdu ! Mais vous avez quand même gagné 1 500€ !") ou 48 000€ c'est bien cela ?

Et, en plus, proposer au candidat de recommencer !

Pour le rang 12, une simple Msgbox("Vous avez gagné 1 000 000€, félicitations vous êtes millionaire !") suffirait non ?

Un genre de :

If rang=12 then

Msgbox("Vous avez gagné 1 000 000€, félicitations vous êtes millionaire !")


Ah, autant pour moi je n'avais pas vu votre message sur la 2ème page !

En effet, cela fonctionne très bien

Par contre il semblerait que les questions ne soient plus choisies aléatoirement

Le top serait aussi d'ajouter une fonction Joker 50/50 qui permettrait au joueur de supprimer 2 mauvaises réponses, et utilisable une seule fois. Mais là, je ne sais pas du tout comment m'y prendre ...

Oui reste le 50/50 heu ? bonsoir !

Le super top serait de "cocher" les question déjà posées afin que d'une partie à l'autre elles ne se répètent pas, et seulement une fois toutes les questions d'un niveau posé, une init de ces coche serait fait pour repartir avec la batterie complète non ?

@ bientôt

LouReeD

Oui bonsoir du coup

Mmmmh je pense que le plus important ce serait de refaire marcher les questions aléatoires Mais je ne vois pas d'où peut venir le problème, c'est peut-être car il n'y a plus la fonction rnd ?

Si si il y est dans module un "tirage_question"

Et si vous testez votre application de départ vous verrez que la suite des questions à chaque ouverture du était déjà la même !

Sub tirage_question(rang)

If rang = 1 Then
    ActiveSheet.Cells(26 - (2 * rang), 15).Interior.ColorIndex = 12 ' couleur niveau actif
Else
    ActiveSheet.Cells(26 - (2 * rang), 15).Interior.ColorIndex = 12 ' couleur niveau actif
    ActiveSheet.Cells(26 - (2 * (rang - 1)), 15).Interior.ColorIndex = 1 ' couleur en fond noir niveau précédent
End If
Randomize ' à ajouter afin d'avoir réellement une suite aléatoire...
x = Int(Rnd * 9 + 1)
Range("F14") = Worksheets("Questions-réponses").Cells(x, 1 + (6 * (rang - 1)))
Range("F18") = Worksheets("Questions-réponses").Cells(x, 2 + (6 * (rang - 1)))
Range("K18") = Worksheets("Questions-réponses").Cells(x, 3 + (6 * (rang - 1)))
Range("F22") = Worksheets("Questions-réponses").Cells(x, 4 + (6 * (rang - 1)))
Range("K22") = Worksheets("Questions-réponses").Cells(x, 5 + (6 * (rang - 1)))

End Sub

Mais je crois que "informatiquement" RND sort une liste aléatoire, mais celle-ci est "constante" !!!

c'est à dire qu'à chaque ouverture du fichier, RND donnera la même suite numérique, qui du coup ne parait plus aléatoire...

puisque Rnd prendra en référence une constante "matériel"

Donc avant RND il faut utiliser la fonction Randomize afin d'avoir une référence de Rnd différente à chaque utilisation !

Fichier-joint

@ bientôt

LouReeD

38qvgdm-loureed.xlsm (39.17 Ko)

Merci de vous impliquer autant dans mon projet

En effet ça fonctionne beaucoup mieux désormais ! La question 1 ne commence plus non plus par la même question

Bon eh bien, le jeu commence à ressembler à quelque chose merci beaucoup !

Je vais essayer de faire une macro pour féliciter le gagnant s'il va jusqu'à 1 000 000€, puis pourquoi pas le fameux 50/50.

Le 50/50 je le vois avec un randomize + rnd sur quatre valeur

puis test que la valeur ne soit pas la bonne réponse, sinon on recommence, puis un deuxième randomize rnd sur quatre valeur puis test que ce n'est ni la bonne réponse ni la réponse déjà retirée... puis ensuite effacement des réponses concernées, tout cela sur un clic bouton, bouton qui disparaît une fois le 50/50 effectué.

A faire réapparaitre lors du clic "commencer la partie"

@ bientôt

LouReeD

Ah d'accord ! Et donc il faudrait que j'utilise plutôt une fonction suppr qui supprimerai les mauvaises réponses ou bien une fonction couleur qui surlignerai en noir le texte des 2 mauvaises réponses ?

Merci beaucoup !

Après c'est vous qui choisissez !

C'est votre projet, je vais certainement me "l'approprier" ...

J'aime bien si si

@ bientôt

LouReeD

Je pense que je vais opter pour la fonction qui change de couleur

Pour afficher un message "Bravo vous êtes millionnaire !", j'utilise la même fonction que pour la fonction perdre ?

Rechercher des sujets similaires à "jeu qui veut gagner millions"