Incrémentation du résultat

Bonjour tout le monde !

Je souhaite créer un qcm pour enfant sur VBA mais le problème c'est que je n'arrive pas à incrémenter le résultat de 1 si la réponse est bonne

Voici mon code :

Sub Miseajours()
' Cette macro remet le résultat à 0

If Range("QCM") = 1 Then
Range("res") = 0
End If

End Sub

Sub Resultat()
' Cette macro incrémente de 1 le résultat pour chaque bonne réponse
Dim i As Long
If Range("D8") = Worksheets("Reponses").Cells(1, 5).Value Then
Range("Res").Value = Range("Res").Value + 1
Application.Speech.Speak "Bonne réponse"
Else
Application.Speech.Speak "Mauvaise réponse"
End If
If (Range("QCM") > 9) Then
i = 0
End If
i = i + 1
End Sub

Sub Bouton2_Cliquer()
' Cette macro met la réponse à 1

Call Miseajours
Range("Reponse") = 1
Call Resultat
End Sub
Sub Bouton3_Cliquer()
' Cette macro met la réponse à 2

Call Miseajours
Range("Reponse") = 2
Call Resultat
End Sub
Sub Bouton4_Cliquer()
' Cette macro met la réponse à 3

Call Miseajours
Range("Reponse") = 3
Call Resultat
End Sub
Sub QuestionSuivante()
If (Range("QCM") > 9) Then
Range("QCM") = 1
MsgBox "Fin du QCM !"
Else
Range("QCM") = Range("QCM") + 1
Range("Reponse") = 0
End If
End Sub

PS : J'ai un autre onglet ou les réponses sont notées dans la colonne E

Aidez moi SVP


Je dois le finir pour ce soir du coup si mon sauveur existe qu'il vient m'aider

Bonsoir,

Merci de joindre un fichier, la réponse sera plus facile à obtenir. Surtout si c'est urgent !!

Cdt

Harissa23

Le voici j’espère que tu pourras m'aider

11qcm.xlsm (229.91 Ko)

Je ne suis pas certain d'arriver à t'aider, mais bon déjà t'inciter à joindre un fichier c'est déjà un bon début d'aide.

Par contre ton fichier est sans macros ^^

Au pire les macros sont écrit au dessus mais je le renvoie quand même avec ^^


Il faut juste que j'arrive a passer a la ligne suivante (dans l'onglet réponses a la colonne E) a chaque passage de question

J'ai essayé une boucle for mais ça m'a fait passer le tout dans 1 seule question du coup je me dis que je devrais le placer ailleurs

Vous en pensez quoi ?

14qcm.xlsm (237.22 Ko)

Sub Resultat()

' Cette macro incrémente de 1 le résultat pour chaque bonne réponse

If Range("Res") = Worksheets("Reponses").Cells(1, 5) Then

Range("Res").Value = Range("Res").Value + 1

MsgBox "Bonne réponse"

Else

MsgBox "Mauvaise réponse"

End If

End Sub

J'ai remplacé Application.Speech.Speak par une msgbox, mais visiblement j'ai faux a chaque fois ^^ même si je ne suis pas bon en géographie... il y a bien un des 3 choix qui devrai être bon.

Je pense qu'il y a déja un problème à ce niveau.

Il y a quoi dans la macro "Miseajours"

Peut tu joindre tous tes fichiers, en supprimant toutes données sensible comme des noms de gamin ou autre.


Sub Resultat()

' Cette macro incrémente de 1 le résultat pour chaque bonne réponse

MsgBox (Range("Reponse"))

MsgBox (Worksheets("Reponses").Cells(5, 5))

If Range("Reponse") = Worksheets("Reponses").Cells(5, 5) Then

MsgBox (Range("Res").Value)

MsgBox (Worksheets("Reponses").Cells(5, 5))

Range("Res").Value = Range("Res").Value + 1

MsgBox "Bonne réponse"

Else

MsgBox "Mauvaise réponse"

End If

End Sub

Visiblement l'incrémentation fonctionne. C'est Cells(1, 5) qui est faux l'a tu es en Cells(5, 5). ( j'aurai du le voir plus vite ^^)

N'hésites à faire comme j'ai fait avec du msgbox pour voir les valeurs retournés.

Sub Resultat()
' Cette macro incrémente de 1 le résultat pour chaque bonne réponse

If Range("Reponse") = Worksheets("Reponses").Cells(1, 5) Then
      Range("Res").Value = Range("Res").Value + 1
      Application.Speech.Speak "Bonne réponse"
Else
      Application.Speech.Speak "Mauvaise réponse"
End If

End Sub

je l'ai un peu modifié maintenant le problème c'est que dans le cells je veux que la ligne s'incrémente de 1 à chaque passage de question

La macro miseajour remet juste le résultat à 0 à chaque début du qcm

Oui je viens de le voir, je crois que j'ai "mal aux yeux" ^^ Sinon je me suis un peu planté mais l'erreur est dans le coin.

Désolé, je suis a coté de la plaque pour une réponse efficace visiblement. Je fais une pause et je revient

Sinon il te faut mettre une variable dans Cells( genre j = Range("Reponse") et ensuite cells(j, 5)

Prends ton temps je sais que mes codes sont pas faciles à lire (oui je me complique trop la vie ^^)

je vais essayer de les simplifier et mettre des commentaires

Sub Resultat()
' Cette macro incrémente de 1 le résultat pour chaque bonne réponse
j = Range("QCM")
If Range("Reponse") = Worksheets("Reponses").Cells(j, 5) Then
Range("Res").Value = Range("Res").Value + 1
MsgBox "Bonne réponse"
Else
MsgBox "Mauvaise réponse"
End If

End Sub

Cela devrait être bon...

J'ai changé quelques truc dans le code et ça a finalement marché ( Enfin !!!!! )

Un grand merci à toi tu es officiellement mon sauveur !

Vraiment merci

Rechercher des sujets similaires à "incrementation resultat"