Cellule clignotante

Bonjour,

J'ai besoin de votre aide pour finaliser mon fichier.

Dans "suivi chantier"

En cellule M, j'ai une date x

En cellule N, je rentrerai une date.

ce que je voudrais, si la date en N est à moins 3 jours de la date en M, alors la cellule en N clignote.

le clignotement doit s’arrêter que si je rentre "ok" dans la cellule N.

c'est possible à faire par VBA ?

Merci par avance.

Bonjour,

Un dispositif relativement simple :

MFC colonne M :

=ET($M2<>"";ABS($M2-$N2)<3;MOD(SECONDE(MAINTENANT());3)=0)

colore cellule en noir

=ET($M2<>"";ABS($M2-$N2)<3;MOD(SECONDE(MAINTENANT());3)=1)

colore cellule en rouge

Provoque une alternance ternaire : noir-rouge-rien toutes les secondes.

Tu peux ramener à une alternance binaire en remplaçant 3 par 2 dans la fonction MOD

Tu peux compléter le mouvement ternaire avec une 3e MFC : formule identique, mais MOD(...)=2

Tu peux choisir d'autres types de mise en forme qui alterneront, le principe est là...

Le dispositif d'alerte proprement dit (en Module standard) :

Dim t

Sub Alerte()
    t = Now + TimeValue("00:00:01")
    Application.OnTime t, "Alerte"
    ActiveSheet.Calculate
End Sub

Sub StopAlerte()
    On Error Resume Next
    Application.OnTime t, "Alerte", , False
End Sub

Très simple ! Quand la procédure est lancée, elle s'auto-entretient jusqu'à ce que la procédure d'arrêt intervienne.

La commande Calculate provoque un recalcul qui permet à la MFC d'alterner...

La variable t doit évidemment être au niveau module (utilisée par les deux procédures).

Lancement de l'alerte :

Dans la procédure évènementielle Change :

'Vérification conditions de lancement Alerte clignotante
    If Target.Column = 14 Then
        Alerter
    End If

Ta procédure étant programmée par ailleurs, il a paru préférable de renvoyer à une procédure auxiliaire lorsque Target est en colonne N.

Cette procédure :

Sub Alerter()
    Dim i%
    With Me.UsedRange
        For i = 2 To .Rows.Count
            On Error Resume Next
            If .Cells(i, 13) <> "" Then
                If Abs(.Cells(i, 13) - .Cells(i, 14)) < 3 Then
                    Alerte
                    Exit Sub
                End If
            End If
        Next i
        StopAlerte
    End With
End Sub

On vérifie si une cellule répond à la condition d'alerte pour la lancer. Si aucune ne répond on lance l'arrêt...

Pour ce qui est de la condition, elle n'était pas très précise dans ton propos, je l'ai donc interprétée à la lettre, soit la valeur absolue de la différence entre M- et N- inférieure à 3. Tu ajusteras à la condition que tu veux (également dans les MFC).

Ce dispositif est complété par un arrêt à la désactivation de la feuille, et une relance à son activation :

Private Sub Worksheet_Activate()
    Alerter
End Sub

Private Sub Worksheet_Deactivate()
    StopAlerte
End Sub

Ainsi qu'un arrêt à la fermeture du classeur :

Private Sub Workbook_BeforeClose(Cancel As Boolean)
    StopAlerte
    Me.Save
End Sub

A tester.

Ce type de dispositifs n'est pas toujours très stable, et il convient de tester dans toutes les conditions pour vérifier s'il répond aux conditions prévues, surtout l'arrêt...

(Honnêtement, c'est toujours amusant, mais je n'en utilise pas pour travailler, il est d'ailleurs difficile de travailler lorsqu'un clignotement est en cours...)

Cordialement.

Bonjour,

Merci de ta réponse rapide. je ne pensais pas que ce soit si complexe.

je vais tester et te dire ce qu'il en est.

Je t'ai précisé qu'il s'agissait d'un dispositif simple... Il y en a d'autres !

ca fonctionne très bien.

dans cette condition :

Code: Tout sélectionner

Sub Alerter()

Dim i%

With Me.UsedRange

For i = 2 To .Rows.Count

On Error Resume Next

If .Cells(i, 13) <> "" Then

If Abs(.Cells(i, 13) - .Cells(i, 14)) < 3 Then

Alerte

Exit Sub

End If

End If

Next i

StopAlerte

End With

End Sub

lorsque je modifie cette ligne :

If Abs(.Cells(i, 13) - .Cells(i, 14)) < 3 Then

en mettant 4 à la place de 3, rien ne se passe. ya t'il autre chose que je dois modifier pour avoir un délai inférieur à 3 jours au lieu de 2 jours ?

La même condition est dans les MFC, il faut que tu les alignes.

re,

Dim t

Sub Alerte()

t = Now + TimeValue("00:00:01")

Application.OnTime t, "Alerte"

ActiveSheet.Calculate

End Sub

Comment je peux modifier mon MFC ?

j'ai tout essayé mais rien à faire, je ne vois vraiment pas ce qu'il faut modifier.

C'est la condition dans la formule des MFC qu'il faut modifier selon tes souhaits !

=ET($M2<>"";ABS($M2-$N2)<3;MOD(SECONDE(MAINTENANT());3)=0)

(la condition surlignée).

ahh Merci.

ça y est ça marche.

Je te remercie beaucoup pour ton aide.