Temporisation à la milliseconde d'une macro

Option Explicit
Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
Const Tempo = 100

Sub Parcourir()
Dim oldStyle, oldSize, oldRGB, xpt As Point, i&, j&

  ActiveSheet.ChartObjects("Graphique 1").Activate
  For i = 1 To ActiveChart.SeriesCollection(1).Points.Count
    If i > 1 Then
      With ActiveChart.SeriesCollection(1).Points(i - 1)
        .MarkerStyle = oldStyle
        .MarkerSize = oldSize
        .MarkerBackgroundColor = oldRGB
      End With
    End If
      
      With ActiveChart.SeriesCollection(1).Points(i)
        oldStyle = .MarkerStyle
        oldSize = .MarkerSize
        oldRGB = .MarkerBackgroundColor
        .MarkerStyle = 8
        .MarkerSize = 14
        .MarkerBackgroundColor = RGB(255, 0, 0)
      End With
      
      For j = 1 To 2: DoEvents: Next j  'pour visualiser le point
      Sleep Tempo
  Next i
  
  With ActiveChart.SeriesCollection(1).Points(i - 1)
    .MarkerStyle = oldStyle
    .MarkerSize = oldSize
    .MarkerBackgroundColor = oldRGB
  End With
End Sub

Option Explicit
Private NbrDéclen As Long
Private Declare Function SetTimer Lib "user32.dll" _
   (ByVal hwnd As Long, ByVal nIDEvent As Long, ByVal uElapse As Long, ByVal lpTimerFunc As Long) As Long
Private Declare Function KillTimer Lib "user32.dll" _
   (ByVal hwnd As Long, ByVal nIDEvent As Long) As Long

Public Sub LancerTimer(DuréeEntreTops As Long)
Rem. —— Lancer le timer pour une durée désirée entre chaque top.
'       Remarque: ce timer se désactivera de lui même après 10 déclenchements non consultés
NbrDéclen = 0
SetTimer 0, 0, DuréeEntreTops, AddressOf MonTimer
End Sub

Public Function TimerTop() As Boolean
Rem. —— Juste avant action à synchroniser faire: Do Until TimerTop: Loop
DoEvents
TimerTop = NbrDéclen > 0
If TimerTop Then NbrDéclen = NbrDéclen - 1
End Function
'

Private Sub MonTimer(ByVal hwnd As Long, ByVal uMsg As Integer, ByVal idEvent As Integer, ByVal dwTime As Long)
NbrDéclen = NbrDéclen + 1
If NbrDéclen > 9 Then KillTimer 0, idEvent
End Sub

Option Explicit
Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
Const Tempo = 0

Sub Parcourir()

Dim xy(1 To 999, 1 To 2), Npoints&, x0 As Double, y0 As Double
Dim shp As Shape, pnt As Point, crt As Series
Dim i&, T0 As Single

'initialisation
Set shp = ActiveSheet.Shapes("Oval 1")
x0 = Worksheets("Feuil1").ChartObjects(1).Left
y0 = Worksheets("Feuil1").ChartObjects(1).Top
shp.Left = x0: shp.Top = y0
Set crt = Worksheets("Feuil1").ChartObjects(1).Chart.SeriesCollection(1)

'calcul des coordonnées successives
Npoints = crt.Points.Count
For i = 1 To Npoints
  Set pnt = crt.Points(i)
  xy(i, 1) = pnt.Left + x0: xy(i, 2) = pnt.Top + y0
Next i
  
'parcours de la courbe
T0 = Timer
For i = 1 To Npoints
  shp.Left = xy(i, 1): shp.Top = xy(i, 2)
  shp.Visible = msoCTrue
  DoEvents
  Sleep Tempo
Next i
  DoEvents
  Sleep Tempo
  
'Fin et affichage
T0 = Timer - T0
shp.Left = x0: shp.Top = y0
MsgBox "Durée parcours : " & Format(T0, "0.000") & " sec. " & vbLf & vbLf & _
  " soit " & Format(T0 / Npoints, "0.000") & " sec. par point"
End Sub

Option Explicit
Private Type LARGE_INTEGER: LowPart As Long: HighPart As Long: End Type
Private Declare Function QueryPerformanceFrequency Lib "kernel32.dll" (ByRef lpFrequency As LARGE_INTEGER) As Long
Private Declare Function QueryPerformanceCounter Lib "kernel32.dll" (ByRef lpPerformanceCount As LARGE_INTEGER) As Long
Public CyclesRéf As Long

Function DuréeCycles(Optional ByVal Cycles As Long = 1) As Double
DuréeCycles = Cycles / CyclesParSec
End Function

Function CyclesParSec(Optional ByVal Sec As Double = 1#) As Long
Dim Fréq As LARGE_INTEGER
If QueryPerformanceFrequency(Fréq) = 0 Then
   MsgBox "Minuteur haute précision non disponible.", vbCritical, "CyclesParSec"
ElseIf Fréq.LowPart < 0 Or Fréq.HighPart <> 0 Then
   MsgBox "Minuteur haute précision: fréquence improbable.", vbCritical, "CyclesParSec"
ElseIf Sec <> 1 Then
   CyclesParSec = Int(Fréq.LowPart * Sec + 0.5)
Else
   CyclesParSec = Fréq.LowPart: End If
End Function

Function CyclesDif() As Long
CyclesDif = CyclesCptr - CyclesRéf: If CyclesDif < 0 Then CyclesDif = CyclesDif + &H40000000
End Function

Function Synchroniser(ByVal Cycles As Long)
Do: DoEvents: Loop Until CyclesDif > Cycles
CyclesRéf = CyclesRéf + Cycles And &H3FFFFFFF
End Function

Function CyclesCptr() As Long
Dim Cptr As LARGE_INTEGER, Cycles As Long
If QueryPerformanceCounter(Cptr) = 0 Then
   MsgBox "Minuteur haute précision non disponible.", vbCritical, "CyclesCptr": Exit Function: End If
Cycles = Cptr.LowPart And &H3FFFFFFF
End Function