Je voudrais traduire cet algorithme en Visual basic
Je voudrais faire un QCM, dans cet exemple, je pose une question et l'utilisateur a le choix entre 2 réponses. Si la réponse est juste il peut alors lire "bonne réponse !" et si sa réponse est fausse il peut alors lire "mauvaise réponse !".
A la fin du QCM je voudrais que le score soit compté "1 question juste sur 1" etc.
variable bonne_reponse, resultat, mauvaise_reponse en caractère
variable score en numérique
DEBUT
fonction choix_reponse
si bonne_reponse = 1 alors
ecrire "bonne réponse !"
fin si
sinon
ecrire "mauvaise réponse !"
fin sinon
fin fonction
ecrire "Quelle est la surface de l'Afghanistan ?"
ecrire "650 000km²"
lire bonne_reponse
ecrire "550 000km²"
lire mauvaise_reponse
choix_reponse
si bonne reponse = 1 alors
score = score +1
ecrire score
fin si
Si vous avez besoin d'informations n'hésitez pas !
EDIT :
Pour afficher ton score de façon "8/10" par exemple (ou sous forme de phrase comme tu l'a dit) il te suffit d’incrémenter une variable a chaque question poser et une deuxième que tu incrémentes a chaque réponse qui est vrai...
Salut ludolost,
alors crée une windows form nommée form1
insères-y un label que tu appelle "question", un label que tu nomme "points", un bouton que tu nomme "Bt_Rep" et deux checkbox (Rep1 et Rep2)
ensuite insère ca dans ton code (entre Public Class Form1 et End Class)
Dim resultat As String 'déclaration de la variable de carractères
Dim score, nb_question As Integer 'déclaration des variables score et nb_question (nombre entier)
Private Function choix_reponse() 'nouvelle fonction choix_reponse
If Rep1.Checked = True Then 'si la première réponse est choisie
MsgBox("Bonne réponse")
score += 1 'incrémentation de la variable score
Else 'sinon
MsgBox("mauvaise réponse")
End If
nb_question += 1
resultat = score & " Réponses juste(s) sur " & nb_question
points.Text = resultat
End Function 'fin de la fonction
Private Sub Bt_Rep_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Bt_Rep.Click 'évenement button_click, lorsque le bouton répondre est clické
If Rep1.Checked = False And Rep2.Checked = False Then 'Si aucune réponse n'est choisie
MsgBox("Veuillez choisir une réponse")
Else 'sinon
choix_reponse() 'lance la fonction choix_reponse
End If
End Sub
J'aimerai comprendre quelque chose. J'ai ce code :
Const NOOFQS = 3
'Used to manipulated the unicode values of bulleted lists
Const UD_CODE_1 = 111
Const UD_CODE_2 = 8226
Public QNo As Integer
Public ExitFlag As Boolean
Public Qs() As String
Public Choices() As String
Public Ans() As Integer
Public UserAns() As Integer
___________________________________________________________________________________________________
Sub NextSlide()
' Store the ans for later
'UserAns(QNo - 1) = 1
If QNo < NOOFQS Then
QNo = QNo + 1
SlideShowWindows(1).Presentation.Slides("QSlide").Shapes(1).TextFrame.TextRange.Text = Qs(QNo - 1)
AssignValues
Else
Call StopQuiz
End If
DoEvents
End Sub
___________________________________________________________________________________________________
Sub PreviousSlide()
Static X As Integer
If QNo > 1 Then
QNo = QNo - 1
AssignValues
End If
End Sub
___________________________________________________________________________________________________
Sub StopQuiz(Optional EndType As Boolean = False)
' EndType is used as a boolean Flag to indicate whether the user ran out of time
' or whether it was normal exit
Dim ScoreCard As Integer
Dim Ctr As Integer
ExitFlag = True
With SlideShowWindows(1)
For Ctr = 0 To NOOFQS - 1
If Ans(Ctr) = UserAns(Ctr) Then ScoreCard = ScoreCard + 1
Next Ctr
If EndType = False Then
.Presentation.Slides("EndSlide").Shapes("Closing").TextFrame.TextRange.Text = "Your score is : " & ScoreCard & " correct out of " & NOOFQS
Else
.Presentation.Slides("EndSlide").Shapes("Closing").TextFrame.TextRange.Text = "Sorry!!! Either you ran out of time or you chickened out" _
& vbCrLf & "Better luck next time." & vbCrLf _
& "Your score is: " & ScoreCard & " correct out of " & NOOFQS
End If
.View.GotoSlide (.Presentation.Slides("EndSlide").SlideIndex)
End With
End Sub
___________________________________________________________________________________________________
Sub StopIt()
Call StopQuiz(True)
End Sub
___________________________________________________________________________________________________
Sub BeginQuiz()
Dim Ctr As Integer
ReDim Qs(NOOFQS)
ReDim Ans(NOOFQS)
ReDim UserAns(NOOFQS)
ReDim Choices(NOOFQS, 3)
' All the questions
Qs(0) = "1)What does Narcissistic mean?"
Qs(1) = "2)What does Confidant mean?"
Qs(2) = "3)Black Pearl is a nick name for?"
' Set all user answers to negative
For Ctr = 0 To NOOFQS - 1
UserAns(Ctr) = -1
Next Ctr
' All the choices 3 each for a question
Choices(0, 0) = " Very Vain"
Choices(0, 1) = " Very Sleepy"
Choices(0, 2) = " Indecisive"
Choices(1, 0) = " Excessive Pride"
Choices(1, 1) = " Trusted Friend"
Choices(1, 2) = " Secret"
Choices(2, 0) = " Mohammed Ali"
Choices(2, 1) = " Pele"
Choices(2, 2) = " George Foreman"
' Provide the answer list here.
' Ans(0) = 0 means that the correct answer to the 1st question is the 1st choice.
' Ans(1) = 1 means that the correct answer to the 2nd question is the 2nd choice.
' Ans(2) = 1 means that the correct answer to the 3rd question is the 2nd choice.
Ans(0) = 0
Ans(1) = 1
Ans(2) = 1
QNo = 1
AssignValues
With SlideShowWindows(1)
.View.GotoSlide (.Presentation.Slides("QSlide").SlideIndex)
End With
' Comment the line below to stop the timer.
' Call Tmr
End Sub
___________________________________________________________________________________________________
Sub SetBulletUnicode(ShapeName As String, Code As Integer)
With SlideShowWindows(0).Presentation.Slides("QSlide").Shapes(ShapeName).TextFrame.TextRange.ParagraphFormat.Bullet
.UseTextFont = msoTrue
.Character = Code
End With
End Sub
___________________________________________________________________________________________________
Sub ButtonChoice1()
UserAns(QNo - 1) = 0
AssignValues
End Sub
___________________________________________________________________________________________________
Sub ButtonChoice2()
UserAns(QNo - 1) = 1
AssignValues
End Sub
___________________________________________________________________________________________________
Sub ButtonChoice3()
UserAns(QNo - 1) = 2
AssignValues
End Sub
___________________________________________________________________________________________________
Sub Tmr()
'Just in the eventuality that you click the start button twice
'isRunning stores the current state of the macro
'TRUE = Running; FALSE = Idle
ExitFlag = False
Static isRunning As Boolean
If isRunning = True Then
End
Else
isRunning = True
Dim TMinus As Integer
Dim xtime As Date
xtime = Now
With ActivePresentation.Slides(2).Shapes("Timer")
'Countdown in seconds
TMinus = 59
Do While (TMinus > -1)
DoEvents
' Rather crude way to determine if a second has elapsed
If ExitFlag = True Then
.TextFrame.TextRange.Text = "00:00:00"
isRunning = False
Exit Sub
End If
If Format(Now, "ss") <> Format(xtime, "ss") Then
xtime = Now
.TextFrame.TextRange.Text = Format(TimeValue(Format(Now, "hh:mm:ss")) - _
TimeSerial(Hour(Now), Minute(Now), Second(Now) + TMinus), "hh:mm:ss")
TMinus = TMinus - 1
' Let the display refresh itself
End If
Loop
End With
Debug.Print "came here"
isRunning = False
StopQuiz True
End
End If
End Sub
___________________________________________________________________________________________________
Sub AssignValues()
SetBulletUnicode "Choice1", UD_CODE_1
SetBulletUnicode "Choice2", UD_CODE_1
SetBulletUnicode "Choice3", UD_CODE_1
Select Case UserAns(QNo - 1)
Case 0
SetBulletUnicode "Choice1", UD_CODE_2
Case 1
SetBulletUnicode "Choice2", UD_CODE_2
Case 2
SetBulletUnicode "Choice3", UD_CODE_2
End Select
With SlideShowWindows(1).Presentation.Slides("QSlide")
.Shapes(1).TextFrame.TextRange.Text = Qs(QNo - 1)
.Shapes("Choice1").TextFrame.TextRange.Text = Choices(QNo - 1, 0)
.Shapes("Choice2").TextFrame.TextRange.Text = Choices(QNo - 1, 1)
.Shapes("Choice3").TextFrame.TextRange.Text = Choices(QNo - 1, 2)
End With
End Sub
___________________________________________________________________________________________________
Sub ShowAnswers()
Dim AnsList As String
AnsList = "The answers are as follows:" & vbCrLf
For X = 0 To NOOFQS - 1
AnsList = AnsList & Qs(X) & vbTab & " Answer:" & Choices(X, Ans(X)) & vbCrLf
Next X
MsgBox AnsList, vbOKOnly, "Correct answers"
End Sub
Que fait-il ?
Alors, il est sur PowerPoint.
Il pose 3 questions, une par diapositive comme on peut le voir ici :
' All the questions
Qs(0) = "1)What does Narcissistic mean?"
Qs(1) = "2)What does Confidant mean?"
Qs(2) = "3)Black Pearl is a nick name for?"
mais je ne vois pas comment, rajouter une question supplémentaire.
Evidemment j'ai essayer de faire :
Qs(3) = "4)une question"
En y mettant des réponses, avec la réponse qui est juste et j'ai modifier ce qu'il y avait avec.
Mais quand je lance le diaporama, il me fait comme si la nouvelle question n'existait pas.
Je ne vois pas comment faire pour rajouter des questions...
A oui, a la fin du questionnaire, il donne le nombre de réponse juste.
Le message qui suit est une réponse automatique activée par un membre de l'équipe. Les réponses automatiques leur permettent d'éviter d'avoir à répéter de nombreuses fois la même chose, ce qui leur fait gagner du temps et leur permet de s'occuper des sujets qui méritent plus d'attention. Nous sommes néanmoins ouverts et si vous avez une question ou une remarque, n'hésitez pas à contacter la personne en question par Message Privé. Pour plus d'informations, nous vous invitons à lire les règles générales du forum
Avant de poster un message, vérifiez la date du sujet dans lequel vous comptiez intervenir.
Si le dernier message sur le sujet date de plus de deux mois, mieux vaut ne pas répondre. En effet, le déterrage d'un sujet nuit au bon fonctionnement du forum, et l'informatique pouvant grandement changer en quelques mois il n'est donc que rarement pertinent de déterrer un vieux sujet.
Au lieu de déterrer un sujet il est préférable :
soit de contacter directement le membre voulu par messagerie privée en cliquant sur son pseudonyme pour accéder à sa page profil, puis sur le lien "Ecrire un message"
soit de créer un nouveau sujet décrivant votre propre contexte
ne pas répondre à un déterrage et le signaler à la modération
Pas d'aide concernant le code par MP, le forum est là pour ça :)