Cellule clignotante

Bonjour@ tous

Je sais que le sujet a certainement été abordé plusieurs fois , mais je n'y arrive pas ......

Si une âme charitable pouvait m'aider ,

il me faudrait un code qui déclenche le clignotement de cellule à chaque ouverture du fichier sur la feuille active pendant 5 secondes environ .

Conditions : si une des cellules B 27 , C 27 , D 27 ou E 27 ne contient pas le terme OK > la cellule en question clignote pendant 5 secondes ...

Fichier joint

Merci à vous

Hello,

Voici le code à coller dans un module standard :

Option Explicit

Sub LancerClignotement()
    Dim cell As Range, testRange As Range, ClignoteCellules As Range
    Dim StartTime As Double, Etat As Boolean

    Set testRange = ActiveSheet.Range("B27:E27")

    ' On ne garde que les cellules qui ne contiennent pas "OK"
    For Each cell In testRange
        If UCase(cell.Value) <> "OK" Then
            If ClignoteCellules Is Nothing Then
                Set ClignoteCellules = cell
            Else
                Set ClignoteCellules = Union(ClignoteCellules, cell)
            End If
        End If
    Next cell

    If ClignoteCellules Is Nothing Then Exit Sub

    StartTime = Timer
    Etat = False

    Do While Timer - StartTime < 5
        Etat = Not Etat
        If Etat Then
            ClignoteCellules.Interior.Color = vbBlue
        Else
            ClignoteCellules.Interior.Color = vbRed
        End If

        ' Pause de 0,5 seconde
        Pause 0.5
        DoEvents
    Loop

    ' Restauration couleur d'origine
    ClignoteCellules.Interior.ColorIndex = xlNone
End Sub

Private Sub Pause(ByVal Secs As Double)
    Dim EndTime As Double
    EndTime = Timer + Secs
    Do While Timer < EndTime
        DoEvents
    Loop
End Sub

Il faut également coller ce code dans la feuille où tu veux qu'elle s'exécute

Option Explicit

Private Sub Workbook_Open()
    Call LancerClignotement
End Sub

@+

Merci BAROUTE 78 ,

Pour ta réponse ultra rapide ,

la macro fonctionne parfaitement , mais elle ne se lance pas automatiquement à l'ouverture du classeur ,

ai je loupé une étape ?

Bonjour

En attendant que Baroute78 revienne et que je salue colle ce code dans ThisWorkBook

Option Explicit

Private Sub Workbook_Open()
    Call LancerClignotement
End Sub

Merci beaucoup à vous deux !

Ca fonctionne nikel !

Bonne soirée

@+++

Si cela te convient passe le sujet en résolu

Crdlt