Recherche

Imaginons par exemple un jeu créé avec PowerPoint, dans lequel on voudrait compter automatiquement le nombre de clics sur des objets pour déterminer les bonnes et les mauvaises réponses.

Dans cet exemple, il s'agit d'une jeu où des questions seront posées oralement par un animateur. La présentation va comporter une seule diapositive dans laquelle nous aurons ces deux objets, qui vont représenter la bonne et la mauvaise réponse, et que je vais nommer "OK" et "NOK". Quand la réponse sera bonne, l'animateur cliquera sur le bouton OK, et quand la réponse sera mauvaise, l'animateur cliquera sur le bouton NOK.

Chaque clic sur chacun de ces boutons sera comptabilisé et, pourra par exemple, être reporté dans une zone de texte qui indiquera le nombre de bons points.

Par ailleurs, le clic sur la bonne réponse va déclencher un applaudissement, et le clic sur la mauvaise réponse va déclencher un son moins sympa.

Dans ce premier exemple très simplifié, seul le clic sur la bonne réponse sera comptabilisé. Dans l'exemple suivant, vous voyez :

  • deux images de main : la main rouge, nommée "NOK" et la main jaune nommée "OK".
  • deux sons qui vont se déclenchera lors du clic, l'un sur la main jaune et l'autre sur la main rouge.
  • une zone de texte nommée "points" et qui contient pour le moment le chiffre 0.
  • une zone de texte collée à la première, nommée "zdt" et qui contient le mot "Point". Au passage du 2e point, on prévoira le pluriel dans la macro.

Concernant les sons, chacun d'eux va se déclencher au clic sur la main correspondante. Pour cela, sélectionnez le son OK, et sous l'onglet Animation, groupe Animation avancée, cliquez sur Déclencheur et sélectionnez la main jaune (nommée "OK" dans mon exemple). Faites de même pour le son NOK.

Ci-dessous la macro "questions" qui va se déclencher au clic sur la main jaune.

Sub questions()
Dim nb_clic
nb_clic = ActivePresentation.Slides(1).Shapes("points").TextFrame.TextRange.Text
nb_clic = nb_clic + 1
ActivePresentation.Slides(1).Shapes("points").TextFrame.TextRange.Text = nb_clic
If nb_clic > 1 Then ActivePresentation.Slides(1).Shapes("zdt").TextFrame.TextRange.Text = "Points"
ActivePresentation.Slides(1).Shapes("points").TextFrame.TextRange.Text = nb_clic
End Sub

On va également ajouter une macro événementielle qui va déclencher à la sortie du diaporama afin que le compteur soit remis à 0 :

Sub OnSlideShowterminate(ByVal diaporama As SlideShowWindow)
If ActivePresentation.Name = "jeu.pptm" Then
ActivePresentation.Slides(1).Shapes("points").TextFrame.TextRange.Text = "0"
ActivePresentation.Slides(1).Shapes("zdt").TextFrame.TextRange.Text = "point"
End If
End Sub


Avant de lancer le diaporama, n'oubliez pas d'affecter la macro à la main jaune :

  • Sélectionnez la main, puis sous l'onglet Insertion, groupe Liens, cliquez sur Action.
  • Dans la boîte de dialogue, onglet Cliquer avec la souris, cochez Exécuter la macro et sélectionnez la macro "questions".

Pensez par ailleurs à ne pas afficher les objets sons lors du diaporama, ce n'est pas utile de les voir. Pour cela, sélectionnez chacun d'eux, puis sous l'onglet Lecture, cochez l'option Masquer pendant la présentation.


Nous allons compliquer un peu le problème en décidant de déclencher un comptage également lors d'un clic sur la main rouge. Dans mon exemple, je vais ajouter 2 points pour une bonne réponse, et ôter 1 point par mauvaise réponse. Voici la macro :

Sub questions(réponse As Shape)
Dim nb_clic
nb_clic = ActivePresentation.Slides(1).Shapes("points").TextFrame.TextRange.Text
If réponse.Name = "OK" Then
nb_clic = nb_clic + 2
Else: nb_clic = nb_clic - 1
End If

If nb_clic < 0 Then Exit Sub 'si l'on ne souhaite pas descendre en dessous de 0
ActivePresentation.Slides(1).Shapes("points").TextFrame.TextRange.Text = nb_clic
If nb_clic > 1 Then ActivePresentation.Slides(1).Shapes("zdt").TextFrame.TextRange.Text = "Points"
ActivePresentation.Slides(1).Shapes("points").TextFrame.TextRange.Text = nb_clic
End Sub

N'oubliez pas, pour que le code fonctionne correctement, d'affecter également la macro à la main rouge. 

 

 

Statistiques

France 72,1% France
Canada 7,7% Canada
Belgique 3,8% Belgique

Total:

117

Pays
018308647
Aujourd'hui: 48
Hier: 386
Cette semaine: 1.377
Semaine dernière: 2.467
Ce mois: 4.039