Bonjour,
Je reviens vers vous.
Car je suis arrivé à modifier mon code, pour me rapprocher de mon cahier des charges.
Tout n'est pas encore gagné.
Il me manque ne fait 1 chose :
Le fichier créer et envoyé par mail ne donne que réponse bonne ou fausse.
Et j'aimerais obtenir le même type de fichier mais avec la réponse exacte histoire de pouvoir analyser les réponses.
Pour cette partie je n'ai aucune idée.
Merci pour votre aide.
Ci-dessous mon code
[code]
'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 Prénom et Nom ?", "Bonjour" )
Loop
Total = 0 'Le total des points est initialisé
Question = 2 'La première question porte le numéro 1
Application.SlideShowWindows(1).View.GotoSlide 3 'Activation de la dia numéro
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
Sub DiaSuivante()
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()
'La boîte de dialogue
x = MsgBox("Vous avez répondu correctement à " & Total & " questions sur " & Question - 2 & "." _
& Chr(13) & "Vous avez donc " & Int(Total / (Question - 2) * 100) & "% de réussite." _
& Chr(13) & "Cliquez sur le bouton OK", , "Fin du questionnaire" )
Fichier = "C:\test.txt"
'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 - 2
Write #1, Points(i)
Next i
Close #1
'Envoie mail des résultats
Dim ol As Object
Set ol = CreateObject("Outlook.Application" )
Dim olmail As Object
Set olmail = ol.CreateItem(MailItem)
With olmail
.To = "bruno.lectard@cea.fr"
.Subject = "Résultat QCM"
.Attachments.Add "C:\test.txt"
.Send
End With
Set ol = Nothing
Set olmail = Nothing
'suppression fichier
Kill "C:\test.txt"
Module1.DiaSuivante
End Sub
Sub Fermeture()
ActivePresentation.Close
End Sub
[code]
