Je ne parle pas ici d'un compte à rebours qui est plus facile à réaliser et que vous trouverez ici.
Vous souhaitez afficher un chronomètre dans votre présentation PowerPoint, avec un bouton pour démarrer et un autre pour arrêter ?
Contrairement à Excel, PowerPoint ne propose pas de fonction native simple pour ça. Mais avec un peu de VBA et l’API Windows, c’est possible !
La création d'un chrono dans PowerPoint est compliqué parce que PowerPoint ne possède pas la fonction Application.OnTime que l'on connaît dans Excel et qui facilite le timing. Par ailleurs, les boucles DoEvents bloquent souvent l'affichage, et donc la méthode fiable est d’utiliser la fonction Windows SetTimer via une déclaration API.
Préparation de la présentation
- Créez une diapositive vierge.
- Ajoutez une zone de texte, nommez-la "affichage" (important : ce nom servira dans le code).
- Ajoutez deux boutons nommés Démarrer et Arrêter.
Le code
Copiez-collez ce code dans un module :
Private Declare PtrSafe Function SetTimer Lib "user32" (ByVal hwnd As LongPtr, ByVal nIDEvent As LongPtr, _
ByVal uElapse As Long, ByVal lpTimerFunc As LongPtr) As LongPtr
Private Declare PtrSafe Function KillTimer Lib "user32" (ByVal hwnd As LongPtr, ByVal nIDEvent As LongPtr) As Long
#Else
Private Declare Function SetTimer Lib "user32" (ByVal hwnd As Long, ByVal nIDEvent As Long, _
ByVal uElapse As Long, ByVal lpTimerFunc As Long) As Long
Private Declare Function KillTimer Lib "user32" (ByVal hwnd As Long, ByVal nIDEvent As Long) As Long
#End If
Dim TimerID As LongPtr
Dim startTime As Single
Sub StartChrono()
If TimerID <> 0 Then Exit Sub ' Empêche plusieurs timers simultanés
startTime = Timer
TimerID = SetTimer(0, 0, 1000, AddressOf TimerProc)
End Sub
Sub StopChrono()
On Error Resume Next
If TimerID <> 0 Then
KillTimer 0, TimerID
TimerID = 0
End If
End Sub
Sub TimerProc(ByVal hwnd As LongPtr, ByVal uMsg As Long, ByVal idEvent As LongPtr, ByVal dwTime As Long)
Dim elapsed As Single
Dim minutes As Long, seconds As Long
elapsed = Timer - startTime
If elapsed < 0 Then elapsed = elapsed + 86400 ' Corrige passage minuit
minutes = Int(elapsed / 60)
seconds = Int(elapsed Mod 60)
On Error Resume Next
SlideShowWindows(1).View.Slide.Shapes("affichage").TextFrame.TextRange.Text = _
Format(minutes, "00") & ":" & Format(seconds, "00")
End Sub
Liaisons des macros aux boutons
- Sélectionnez votre bouton "Démarrer", sous l'onglet Insertion, cliquez sur Action, cochez Exécuter une macro => StartChrono.
- Faites de même pour votre bouton "Arrêter", en sélectionnant la macro StopChrono.
Test
Affichez le diaporama, puis cliquez sur votre bouton Démarrer : le chrono s’affiche et s’incrémente chaque seconde.
Cliquez sur votre bouton Arrêter pour arrêter le chronomètre.
