Retour vers les QCM

le code Visual Basic dans le fichier ppt:

'Déclaration des variables
Dim Total, Question As Integer
Dim Reponse, Nom As String
Dim Points(100) As Integer 'Déclaration du tableau qui contiendra les réponses
'Procédure pour le clic sur le bouton ICI dans la première dia
Sub Init()
'Une boîte de dialogue pour demandé le nom
Nom = ""
Do While Nom = ""
Nom = InputBox("Quel est votre nom ?", "Bonjour")
Loop
Total = 0 'Le total des points est initialisé
Question = 1 'La première question porte le numéro 1
Application.SlideShowWindows(1).View.GotoSlide 2 'Activation de la dia numéro 2
End Sub
'Procédure pour le clic sur le bouton de bonne réponse
Sub Bon()
Total = Total + 1 'Le total des points est augmenté de 1
Points(Question) = 1 'Le tableau des réponses est complété
Reponse = "bonne." 'Cette variable sera utilisée dans le message affiché par DiaSuivante()
Module1.DiaSuivante 'Appel de la procédure DiaSuivante
End Sub
'Procédure pour le clic sur le bouton de mauvaise réponse
Sub Faux()
Points(Question) = 0 'Le tableau des réponses est complété
Reponse = "fausse." 'Cette variable sera utilisée dans le message affiché par DiaSuivante()
Module1.DiaSuivante 'Appel de la procédure DiaSuivante
End Sub
'Procédure pour le passage à la diapositive suivante - appelée par Bon() et Faux()
Sub DiaSuivante()
'Le message annonce si la réponse était bonne ou mauvaise
'et donne le score
If Total <= 1 Then
Message = "Votre réponse est " & Reponse & Chr(13) & Chr(13) & _
"Votre total actuel: " & Total & " point sur " & Question
Else
Message = "Votre réponse est " & Reponse & Chr(13) & Chr(13) & _
"Votre total actuel: " & Total & " points sur " & Question
End If
x = MsgBox(Message, , "Voici ton résultat")
Question = Question + 1 'Question suivante
'Activation de la dia suivante
Application.SlideShowWindows(1).View.GotoSlide Question + 1
End Sub
'Procédure pour le clic sur le point d'interrogation de la dernière dia
Sub Fin()
Dim xcl As Object 'Déclaration de la variable qui fera référence à Excel
Dim ExcelNonOuvert As Boolean
'La boîte de dialogue
x = MsgBox("Vous avez répondu correctement à " & Total & " questions sur " & Question - 1 & "." _
& Chr(13) & "Vous avez donc " & Int(Total / (Question - 1) * 20) & " sur 20." _
& Chr(13) & "Cliquez sur le bouton OK", , "Fin du questionnaire")
Fichier = Nom & ".txt"
'Première sauvegarde des résultats
'L'insertion des données dans le fichier Excel
On Error Resume Next
Set xcl = GetObject(, "Excel.Application")
'Si Excel est déjà ouvert, GetObject produit une erreur
If Err.Number <> 0 Then ExcelNonOuvert = True
Err.Clear ' Efface la référence de l'erreur
'****** INTRODUIRE DANS LA LIGNE SUIVANTE LE CHEMIN D'ACCES AU FICHIER SUR VOTRE SYSTEME
Set xcl = GetObject("c:\QCM\resultats.XLS")
'Insertion d'une colonne pour introduire les résultats
xcl.Application.Visible = True
xcl.Parent.Windows(1).Visible = True
xcl.Application.Cells.Find(What:="moyenne").Activate
xcl.Application.Selection.EntireColumn.Insert
xcl.Application.ActiveCell.Value = Nom
xcl.Application.ActiveCell.Offset(1, 0).Range("A1").Select
'Introduction des données dans la feuille de calcul
For i = 1 To Question - 1
xcl.Application.ActiveCell.Value = Points(i)
xcl.Application.ActiveCell.Offset(1, 0).Range("A1").Select
Next i
xcl.Application.ActiveWorkbook.Save 'Enregistrement du fichier Excel
'Fermeture d'Excel s'il n'était pas ouvert
If ExcelNonOuvert = True Then xcl.Application.Quit
Set xcl = Nothing
'Deuxième sauvegarde des résultats
'dans un fichier texte
'portant comme nom celui de la personne qui a répondu au questionnaire
Open Fichier For Output Shared As #1
Write #1, Nom
For i = 1 To Question - 1
Write #1, Points(i)
Next i
Close #1

End Sub