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