Discussion :

[ptitbubu]

Bonjour à tous,

Je souhaiterais créer un QCM sous powerpoint cela me semble plus sympa.
Mon but est d'envoyer ce QCM à mes collégues et qu'en retour je reçoive le résultat de leur réponses. Ce qui me permettrait d'analyser les réponses afin de pouvoir les présenter.

Je maitrise assez bien PPT par contre pour ce qui est de la progammation en VBA c'est zéro pointé.

Pourriez-vous m'aider un peu merci.

Ptitbubu

[Invité]

Bonjour

Il faudrait en dire plus si tu as besoin d'aide, et déjà établir une trame de ton projet.

De plus, pour utiliser VBA, il faut que tes collègues aient la version complète de PPT et nous juste la visionneuse.

Philippe

[ptitbubu]

Bonjour,

Mon projet :
- une série de 20 questions à choix multiples
- je souhaite envoyer ce QCM à tous mes collégues (ils ont tous ppt)
- Le but étant de générr un fichier texte ou csv des résultats regroupant toutes les réponses et que celui-ci me soit envoyer par mail automatiquement si c'est faisable. Ce qui me permettrait après de faire une analyse statistique des résultats.

En espérant avoir répondu.

Ptitbubu

[D-D-Du-06]

Bonjour,

avec quelques jours de retard, peut-être un début de solution.

Voilà ci-dessous des macros pour exporter le contenu de boîtes de dialogue dans un fichier texte et à une adresse précise du disque dur. Dossier et sous-dossier doivent déjà exister

Pour que ces macros fonctionnent, il faut valider "Microsoft Scripting Runtine" (dans Visual Basic >> Outils >> Référence)

Cette première macro cible une diapo pariculière

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
 
Sub Con_1()
'
' Macro enregistrée le 02/12/2007 par ToTo
Dim fso, f
Set fso = New Scripting.FileSystemObject
'Ci-dessous le nom et l'adresse du fichier (il est créé s'il n'existe pas, s'il existe les données s'ajoutent etc...
Set f = fso.OpenTextFile("c:\Stage\data\diapo2.txt", ForAppending, True)
f.WriteLine "diapo 2 ; question 1: " & TextBox1.Text
f.WriteLine " ..............."
f.WriteLine "diapo 2 : question 1: " & TextBox2.Text
f.WriteLine " ..............."
f.WriteLine "diapo 2 : question 1: " & TextBox3.Text
MsgBox ("Données enregistrées")
'Me.TextBox1.Text = ""
End Sub

Cette macro récupére toutes les boîtes de dialogue du diaporama

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
 
Sub vadid_tout()
'
' Macro enregistrée le 02/12/2007 par ToTo
'
Dim i As Byte, j As Integer
Dim Obj As Shape
Dim Resultat As String
Dim Cible As Integer
 
For i = 1 To ActivePresentation.Slides.Count
 
    For Each Obj In ActivePresentation.Slides(i).Shapes
 
        If Obj.Type = msoOLEControlObject Then
 
            If Obj.OLEFormat.ProgID = "Forms.TextBox.1" Then
                Resultat = Resultat & ActivePresentation.Slides(i).Name _
                & " / " & Obj.Name & " / " & Obj.OLEFormat.Object.Value & vbCrLf
            End If
 
        End If
 
    Next Obj
 
Next i
 
MsgBox Resultat
 
'Ci-dessous le nom et l'adresse du fichier (il est créé s'il n'existe pas, s'il existe les données s'ajoutent etc...
Cible = FreeFile
Open "C:\Stage\data\toutes.txt" For Append As #Cible
Print #Cible, Now
Print #Cible, Resultat
Print #Cible, "--------"
Close #Cible
'Ci-dessous bout de code pour effacer les boîtes de dialogues
'réinitialisation de tous les CheckBox à False
'For i = 1 To ActivePresentation.Slides.Count
 '   For Each Obj In ActivePresentation.Slides(i).Shapes
      '  If Obj.Type = msoOLEControlObject Then
    '        If Obj.OLEFormat.ProgID = "Forms.CheckBox.1" Then
   '             Obj.OLEFormat.Object.Value = False
  '          End If
 '       End If
'    Next Obj
' Next i
 
End Sub

A+
D D Du 06

[ptitbubu]

Merci pour cette aide.
Ce we en cherchant sur le net des exemples et des "cours" je suis arrivé a la macro suivante. Elle semble fonctionner comme je le souhaite.
Ce n'est peut etre pa sl'idéal et le top du top.
j'obtiens :
- l'ouverture du questionnaire
1) question sur le prénom et nom avant de poursuivre
2) déffilement du QCM sans faire mentions des réponses justes ou fausses
3) à la fin création sur le bureau (je ne sais pas pourquoi ??????) d'un fichier prenomnom.txt et affichage des résultats en nb question juste/le total et en % de réussite.

Il me manque juste 2 point que j'ai pas trouvé.
Le fichier sera en exécutable , est ce comptaible avec les macros ? si oui y a til un ligne pour demander la fermeture automatique aprés affichage des résultats et enregistrement du fichier .yxy.

autre point existe t il une ligne de commande pour me faire parvenir automatiquement le fichier .txt par mail. nous avons tous la même messagerie.


la macro :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
'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()
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 - 2 & "." _
& Chr(13) & "Vous avez donc " & Int(Total / (Question - 2) * 100) & "% des points." _
& Chr(13) & "Cliquez sur le bouton OK", , "Fin du questionnaire")
Fichier = Nom & ".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
 
End Sub

[ptitbubu]

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 :

Sélectionner tout - Visualiser dans une fenêtre à part

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
'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 = "xxx@xxx.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