Faire clignoter une cellule

Private Sub Worksheet_Activate()
Call LancerClignotement
End Sub

Public Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
Public Résultat() As String, Plage As Range, TabIndex As Integer, PremièreAdresse As String
Public Const NombreClignotements = 5
Public Const VitesseClignotements = 7 'de 1(rapide) à 10(lente)
Public Const CouleurClignotement = vbRed 'couleur rouge (ou vbGreen pour Vert, vbBlue pour Bleu, vbYellow pour Jaune, ...etc)

Function TrouverSomme() As Boolean
Erase Résultat
Set Plage = ActiveSheet.Cells.Find(what:="=SUM", LookIn:=xlFormulas, lookAt:=xlPart)
If Plage Is Nothing Then
  TrouverSomme = False
Else
  PremièreAdresse = Plage.Address
  TabIndex = 0
  Do Until Plage Is Nothing
    TabIndex = TabIndex + 1
    ReDim Preserve Résultat(TabIndex)
    Résultat(TabIndex) = Plage.Address
    Set Plage = ActiveSheet.Cells.FindNext(Plage)
    If Plage.Address = PremièreAdresse Then Exit Do
  Loop
  TrouverSomme = True
End If
End Function

Sub Clignoter()
  For x = 1 To UBound(Résultat)
    ActiveSheet.Range(Résultat(x)).Interior.Color = CouleurClignotement
  Next
  Sleep (11 - VitesseClignotements) * 20
  For x = 1 To UBound(Résultat)
    ActiveSheet.Range(Résultat(x)).Interior.Color = xlNone
  Next
  Sleep (11 - VitesseClignotements) * 20
End Sub

Sub LancerClignotement()
If TrouverSomme Then
  n = 1
  While n <= NombreClignotements
    DoEvents
    d = Timer
    Do While f - d < 0.1
      f = Timer
      DoEvents
    Loop
    Clignoter
    n = n + 1
  Wend
End If
End Sub

Public Const NombreClignotements = 5
Public Const VitesseClignotements = 7 'de 1(rapide) à 10(lente)
Public Const CouleurClignotement = vbRed 'couleur rouge (ou vbGreen pour Vert, vbBlue pour Bleu, vbYellow pour Jaune, ...etc)