Probleme Jeu du Pendu - Macro VBA Excel
Bonjour,
je suis nouveau sur ce forum donc j'espère tout faire correctement.
Je suis en 1e année et on me demande de créer un jeu en macro VBA sous excel.
J'ai créé le jeu qui est un jeu du pendu.
Sous mac il tourne parfaitement, lorsque le joueur gagne/perds, alors la macro lui propose de rejouer, si il rejoue alors le fichier excel se remet au début du jeu, si non, le joueur quitte excel.
en revanche sous windows, je ne comprends pas pourquoi mais lorsque l'utilisateur souhaite rejouer, le jeu ne le laisse pas rejoué et le fait automatiquement gagné...
Malheureusement je ne peux pas mettre le fichier .XLSM sur le forum car le format n'est pas accepté.
Je ne sais pas très bien quoi vous donner pour pouvoir m'aider...
Si quelqu'un pouvait m'aider s'il vous plait, par mail ou autre.
Voici la macro qui fait jouer le joueur avec en gras l'endroit ou la macro ne fait pas ce que je veux
Code:
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
| Private Sub Worksheet_Change(ByVal Target As Range)
Const NB_COUPS As Integer = 7
Dim indexInWord As Integer, motATrouver As String, lettre As String, nom As String, cell As Range, lettresATrouver As String, mauvaisesLettres As Integer, CellABC As Range, pendu As Worksheet, x As Integer, tmp As String
Set pendu = ActiveWorkbook.Sheets("Pendu")
'on récupère le nom du joueur
nom = Range("A1994").Value
'Lorsqu'on propose une lettre
If Target.Address = "$D$4" Then
'Récupération des variables stockees dans la feuille (l'utilisation de variables globales posent des problemes dans la Private sub)
motATrouver = pendu.Range("Z1").Value
lettresATrouver = pendu.Range("Z2").Value
mauvaisesLettres = pendu.Range("F2").Value
lettre = UCase(Left(Target.Value, 1))
'Abécédaire
For Each cell In Range("AB3:BA3")
If cell.Value = Range("D4").Value Then
cell.Interior.ColorIndex = 3
cell.Font.Bold = True
End If
Next
'On recherche dans les lettres la premiere lettre donnée
indexInWord = InStr(lettresATrouver, lettre)
'Si la lettre n'est pas dans le mot
If indexInWord = 0 Then
mauvaisesLettres = mauvaisesLettres + 1
'On affiche la partie du corps du pendu correspondante
Call affichePendu(mauvaisesLettres)
'Si on a dépasse le nombre de coups autorises
If mauvaisesLettres > NB_COUPS Then
'On est pendu, on incrémente le nombre de parties perdues
pendu.Range("C8").Value = pendu.Range("C8").Value + 1
pendu.Range("F2").Value = 0
If MsgBox(" Vous avez perdu " & nom & ". Le mot à trouver était " & motATrouver & vbCr & "Voulez vous rejouer " & nom & " ?", vbYesNo) = vbYes Then
Call ThisWorkbook.nouveauMot
Exit Sub
'On ferme l'application si l'user ne rejoue pas
Else
MsgBox ("Merci " & nom & " d'avoir utilisé le jeu du pendu par & .")
Application.Quit
End If
End If
Else
'On parcoure le mot et affiche les lettres correpondantes du mot jusqu'a ce qu'il n'y en ait plus
x = 2
Do Until indexInWord = 0
'On affiche dans B2 la lettre donnée, pour cela on prend l'index dans motATrouver
x = InStr(x, motATrouver, lettre)
tmp = pendu.Range("B2").Value
Mid(tmp, x, 1) = lettre
pendu.Range("B2:B5").Value = tmp
'On incrémente l'index pour l'utiliser comme START dans le mid si jamais la lettre est présente en plusieurs exemplaires
x = x + 1
lettresATrouver = deleteCharByIndex(lettresATrouver, indexInWord)
'On redéfinit l'index si jamais la lettre est présente en plusieurs exemplaires
indexInWord = InStr(lettresATrouver, lettre)
Loop
End If
If lettresATrouver = "" Then
pendu.Range("C7").Value = pendu.Range("C7").Value + 1
pendu.Range("F2").Value = 0
If MsgBox("Bravo " & nom & " vous avez trouvé avec " & mauvaisesLettres & " faute(s)" & vbCr & "Voulez vous rejouer " & nom & " ?", vbYesNo) = vbYes Then
Call ThisWorkbook.nouveauMot
Exit Sub
'On ferme l'application si l'user ne rejoue pas
Else
MsgBox ("Merci " & nom & " d'avoir utilisé le jeu du pendu par & ." & Chr(10) & " UPA-TD06")
Application.Quit
End If
Else
'On store nos données
pendu.Range("F2").Value = mauvaisesLettres
pendu.Range("Z2").Value = lettresATrouver
End If
End If
End Sub |
et voici la macro nouveaumot
Code:
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
| Sub nouveauMot()
Dim nbMots As Integer, ligneMotHasard As Integer, dashedWord As String, lettresATrouver As String, motADeviner As String, difficulteMot As Integer, dico As Worksheet, pendu As Worksheet, cell As Range
Call ThisWorkbook.réinitialiserdessin
'Déclaration du dico et du pendu
Set dico = ActiveWorkbook.Sheets("Dico")
Set pendu = ActiveWorkbook.Sheets("Pendu")
'On cherche a compter le nombre de mots, de cette facon on pourra rajouter des mots au dico
nbMots = Application.CountA(dico.Range("A2:A999"))
'On ajoute les lettres utilisées à l'abécédaire
For Each cell In Range("AB3:BA3")
If cell.Value = Range("D4").Value Then
cell.Font.Bold = True
cell.Interior.ColorIndex = 3
End If
Exit For
Next
'On récupére un mot au hasard
Randomize
ligneMotHasard = Int((nbMots + 2) * Rnd + 2)
motADeviner = dico.Range("A" & ligneMotHasard)
difficulteMot = dico.Range("B" & ligneMotHasard)
dashedWord = dashWord(motADeviner)
lettresATrouver = hiddenLetters(motADeviner)
'On écrit nos données et on réinitialise le reste
'Données cachées
pendu.Range("Z1").Value = motADeviner
pendu.Range("Z2").Value = lettresATrouver
'Bug d'affichage quand on remplace le mot à corriger
pendu.Range("B2").Value = dashedWord
pendu.Range("C2").Value = "Difficulté: " & difficulteMot
'Si l'on appelle un nouveau mot après une tentative on considère la partie comme perdue
If pendu.Range("F2").Value > 0 Then
pendu.Range("C8").Value = pendu.Range("C8").Value + 1
End If
'Réinitialisation de la box
pendu.Range("D4").Value = ""
pendu.Range("F2").Value = 0
End Sub |
MERCI D'AVANCE DE VOTRE AIDE ET COMPREHENSION