Discussion :

[AlexandreTerter]

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 :

Sélectionner tout - Visualiser dans une fenêtre à part

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 :

Sélectionner tout - Visualiser dans une fenêtre à part

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

[clementmarcotte]

Bonjour,

Bonjour,

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...

Mais, si tu "ZIPpes" ton classeur, tu peux mettre le fichier ZIP.