Clignotement

Private Sub CommandButton1_Click()
Dim p#, t#
p = 1 'période du clignotement en secondes
With CommandButton1
  If .Caption = "Lancer" Then
    .Caption = "Arrêter"
1   t = Timer
    While Timer < t + p / 2: DoEvents: Wend
    If IsError([MFC]) Then ThisWorkbook.Names.Add "MFC", True _
      Else ThisWorkbook.Names("MFC").Delete
    GoTo 1
  Else
    .Caption = "Lancer"
    On Error Resume Next
    ThisWorkbook.Names("MFC").Delete
    End
  End If
End With
End Sub

Private Sub Workbook_Open()
Application.OnTime Now, "ThisWorkbook.Lancer"
End Sub

Private Sub Workbook_SheetActivate(ByVal Sh As Object)
Lancer
End Sub

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Source As Range)
Lancer
End Sub

Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Excel.Range)
Lancer
End Sub

Sub Lancer()
Dim p#, t#
p = 1 'période du clignotement en secondes
If [A1] = Date Then
1 t = Timer
  While Timer < t + p / 2: DoEvents: Wend
  If IsError([MFC]) Then ThisWorkbook.Names.Add "MFC", True _
    Else ThisWorkbook.Names("MFC").Delete
  GoTo 1
Else
  On Error Resume Next
  ThisWorkbook.Names("MFC").Delete
  End
End If
End Sub

If CStr(c) <> "" And d.Exists(c.Value) Then

Sub Lancer()
Dim p#, d As Object, tablo, e, doublon As Boolean, t#
p = 1 'période du clignotement en secondes
If Me.UsedRange.Count > 1 Then
  Set d = CreateObject("Scripting.Dictionary")
  tablo = Me.UsedRange 'matrice, plus rapide
  For Each e In tablo
    If CStr(e) <> "" And d.Exists(e) Then doublon = True: Exit For
    d(e) = ""
  Next
End If
If doublon Then
1 t = Timer
  While Timer < t + p / 2: DoEvents: Wend
  If IsError([UR]) Then Me.UsedRange.Name = "UR" _
    Else ThisWorkbook.Names("UR").Delete
  GoTo 1
Else
  On Error Resume Next
  ThisWorkbook.Names("UR").Delete
    End
End If
End Sub

Sub Lancer()
Dim p#, d As Object, tablo, e, doublon As Boolean, t#
p = 1 'période du clignotement en secondes
If Me.UsedRange.Count > 1 Then
  Set d = CreateObject("Scripting.Dictionary")
  tablo = Me.UsedRange 'matrice, plus rapide
  For Each e In tablo
    If CStr(e) <> "" And d(e) Then doublon = True: Exit For
    d(e) = True
  Next
End If
If doublon Then
1 t = Timer
  While Timer < t + p / 2: DoEvents: Wend
  If IsError([UR]) Then Me.UsedRange.Name = "UR" _
    Else ThisWorkbook.Names("UR").Delete
  GoTo 1
Else
  On Error Resume Next
  ThisWorkbook.Names("UR").Delete
  End
End If
End Sub