[PPT-2003] Problème sur un Quiz

[dark0000]

Bonjour,
Je me présente, je m'appel Gael, je suis en stage, et j'ai le devoir de faire, dans une partie de mon projet, un questionnaire animé et dynamique.
Mon problème dans ce quizz est qu'il n'est pas de moi, et surtout que je n'arrive pas à modifier le nombre de réponse.
J'ai crée l'emplacement disponible pour la 4 eme option, mais avec le code ci-dessous, le questionnaire ne ce lance pas (c'est à dire que je reste bloqué à la première page et le "commencer le quiz").

Voici donc le code que je dispose pour m'aider a cette création :

Code :

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
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
 
Const NOOFQS = 4
 
'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 = "Ton score est : " & ScoreCard & " réponses correctes sur " & NOOFQS & vbCrLf & vbCrLf & " (Vous allez être redirigé !)"
 
Else
    .Presentation.Slides("EndSlide").Shapes("Closing").TextFrame.TextRange.Text = "Vous avez quittez le processus !" _
            & vbCrLf & "Vous aurez plus de chance la prochaine fois" & vbCrLf _
            & vbCrLf & "(Vous allez être redirigé)"
 
 
 
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) Question 1"
Qs(1) = "2) Question 2"
Qs(2) = "3) Question 3"
Qs(3) = "4) Question 4"
 
' 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) = "  Réponse 1 (bonne)"
Choices(0, 1) = "  Réponse 2"
Choices(0, 2) = "  Réponse 3"
 
 
 
Choices(1, 0) = "  Réponse 1"
Choices(1, 1) = "  Réponse 2"
Choices(1, 2) = "  Réponse 3 (bonne)"
 
 
 
Choices(2, 0) = "  Réponse 1"
Choices(2, 1) = "  Réponse 2 (bonne)"
Choices(2, 2) = "  Réponse 3"
 
 
 
Choices(3, 0) = "  Réponse 1"
Choices(3, 1) = "  Réponse 2 (bonne)"
Choices(3, 2) = "  Réponse 3"
 
 
 
' 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) = 2
Ans(2) = 1
Ans(3) = 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(1).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 = "Voici la liste des bonnes réponses : " & vbCrLf
For X = 0 To NOOFQS - 1
    AnsList = AnsList & Qs(X) & vbTab & " Réponse : " & Choices(X, Ans(X)) & vbCrLf
Next X
MsgBox AnsList, vbOKOnly, "Réponse correcte : "
End Sub

j'espère que vous pourrez m'aider

Bonne journée, et merci !

[Philippe JOCHMANS]

Bonjour

Peux-tu (si c'est possible confidentiellement) mettre le Quiz en pièce jointe, ce sera plus facile.

Philippe

[dark0000]

Bonjour Philippe

Le format n'est pas supporté par le forum, je n'ai donc pas pu l'envoyer en pièce jointe ...

Pour ce qui est du projet en lui même, voilà comment il ce décompose :

Première page un bloc pour commencer le questionnaire, aucune macro n'ai affilié a ce bloc.
Deuxième page, la question (pareil que le bloc sur la première page), et 3 blocs de réponses lié a la macro : ButtonChoice1/2/3
Troisième page : un bloc affichant le résultat (pas affilié a des macros)
et un autre bloc lié a la macro : ShowAnswers

Donc tout les affichage, lien vers les pages sont fait par le programme en lui même.

[Philippe JOCHMANS]

Re

Envoyé par dark0000

Le format n'est pas supporté par le forum, je n'ai donc pas pu l'envoyer en pièce jointe ...

Zippe le