Faire Clignoter une Cellule Excel

Résolu

Excel
Macro

cesam.m Messages postés 16 Date d'inscription Statut Membre Dernière intervention -
cesam.m Messages postés 16 Date d'inscription Statut Membre Dernière intervention - 28 janv. 2017 à 20:47

Bonjour,

J'ai récupéré une macro pour faire clignoter une cellule excel en essayant de la modifier un peu mais je ne m'en sors pas.

Je souhaite faire clignoter la cellule N7 en fonction d'un calcul en P6.

Le problème est que la cellule N7 clignote sans cesse quel que soit le résultat en P6

Y a t'il une âme charitable pour m'aider?

Voici ce que j'ai:

Dans Modules:

Option Explicit

Dim Temps As Variant

Public Sub Clign()
'Programmation de l'évènement toutes les secondes
Temps = Now + TimeValue("00:00:02")
Application.OnTime Temps, "Clign"
'Affiche l'alerte ou la fait disparaître (alternativement)
With ThisWorkbook
'Fond
With .Sheets("Articles").Range("N7")
.Interior.ColorIndex = IIf(.Interior.ColorIndex = 3, xlNone, 3)
End With

End With
End Sub
Public Sub StopClign()
On Error Resume Next
'Stoppe la gestion de l'évènement OnTime
Application.OnTime Temps, "Clign", , False
On Error GoTo 0
'Cache l'alerte
With ThisWorkbook
'Fond
.Sheets("Articles").Range("N7").Interior.ColorIndex = xlNone

End With
End Sub

et dans This Workbook:

Option Explicit

Private Sub Workbook_Open()
'Lance le clignotement à l'ouverture si la cellule P6 est non vide
If "P6" <> "" Then Clign

End Sub

Private Sub Workbook_BeforeClose(Cancel As Boolean)
'Interrompt le clignotement éventuel avant fermeture
StopClign
End Sub

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
Dim F As Worksheet
If Target.Count > 1 Then Exit Sub
If Not Application.Intersect(Target, Sh.Range("P6")) Is Nothing Then

'Lance ou stoppe le clignotement
If "P6" <> "" Then Clign Else StopClign
End If
End Sub

Merci pour votre aide

A voir également:

Excel faire clignoter une cellule sans macro
Telecharger macro convertir chiffre en lettre excel - Télécharger - Tableur
Excel cellule couleur si condition texte - Guide
Liste déroulante excel - Guide
Proteger cellule excel - Guide
Aller à la ligne dans une cellule excel - Guide

9 réponses

Réponse 1 / 9

Mike-31 Messages postés 18405 Date d'inscription Statut Contributeur Dernière intervention 5 135

Bonjour,

je reconnais ce code,
alors quand tu fais référence à une cellule tu écris
Range("P6") éventuellement [P6] alors que toi tu as écris "P6"

ensuite 2 secondes pour le clignotement me semble lent
("00:00:02")
essaye de réduire à 1 seconde ("00:00:01")
A+
Mike-31

Pas savoir n'est pas un échec, l'échec est le refus d'apprendre.

cesam.m Messages postés 16 Date d'inscription Statut Membre Dernière intervention

Bonjour Mike,

Oui c'est bien ton code merci pour t'on aide.
J'ai modifié selon tes informations mais la cellule n'arrête toujours pas de clignoter.Même quand la cellule P6 est vide.

A vrai dire en P6 j'ai une formule: Ou je vais chercher dans un onglet un nouveau prix.
S' il n'existe pas alors je met vide "".

=SI(ESTNA(EQUIV(ref_em;nx_prix;0));"";INDEX(plage_nx_prix;EQUIV(ref_em;nx_prix;0);2))

As tu une idée pour que Cela Fonctionne?

Voila ma modification:

Private Sub Workbook_Open()
'Lance le clignotement à l'ouverture si la cellule P6 est non vide
If Range("P6") <> "" Then Clign

End Sub

Private Sub Workbook_BeforeClose(Cancel As Boolean)
'Interrompt le clignotement éventuel avant fermeture
StopClign
End Sub

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
Dim F As Worksheet
If Target.Count > 1 Then Exit Sub
If Not Application.Intersect(Target, Sh.Range("P6")) Is Nothing Then

'Lance ou stoppe le clignotement
If Range("P6") <> "" Then Clign Else StopClign
End If
End Sub

Réponse 8 / 9

Mike-31 Messages postés 18405 Date d'inscription Statut Contributeur Dernière intervention 5 135

Alors voila, dans ton module remplace le code Clign et StopClign par

Option Explicit

Dim BlinkTime As Date

Public Sub Clign()
   BlinkTime = Now() + TimeValue("00:00:01") 'le temps du clignotement
    On Error Resume Next
    Sheets("Articles").[N5] 'Zone du clignotement
        If [N5].Interior.ColorIndex = xlNone Then
            If [P6].Value <> "" Then
                [N5].Interior.ColorIndex = 3 'couleur du clignotement rouge
                    Else
                        [N5].Interior.ColorIndex = xlNone 'pas de couleur
                    End If
                Else
            [N5].Interior.ColorIndex = xlNone 'pas de couleur
        End If

   Sheets("Articles").[N15] 'Zone du clignotement
        If [N15].Interior.ColorIndex = xlNone Then
            If [P15].Value = "" Then
                [N15].Interior.ColorIndex = 5 'couleur du clignotement bleu
                    Else
                        [N15].Interior.ColorIndex = xlNone 'pas de couleur
                    End If
                Else
            [N15].Interior.ColorIndex = xlNone 'pas de couleur
        End If

    Application.OnTime BlinkTime, "Clign", , True
End Sub

Sub StopClign()
On Error Resume Next
    Sheets("Articles").Range("N5;N15").Interior.ColorIndex = xlNone
    Application.OnTime BlinkTime, "Clign", , False
End Sub

dans les propriétés de ta feuille

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Call StopClign
Call Clign
End Sub

et dans la Thiswokbook

Private Sub Workbook_Open()
'Lance le clignotement à l'ouverture si les conditions sont requises
Call Clign
End Sub

Private Sub Workbook_BeforeClose(Cancel As Boolean)
'Interrompt le clignotement éventuel avant fermeture
StopClign
End Sub

si tu dois ajouter une autre zone de clignotement il te suffit de dupliquer la partie du code que j'ai séparé dans le code Clign et d'adapter les références cellules
A+
Mike-31

Pas savoir n'est pas un échec, l'échec est le refus d'apprendre.

Discussions similaires

Formule Excel : "SI" une cellule contient un mot, alors ?

Conversion chiffre en lettres excel 2016

copier une macro d'un classeur vers un autre

Cellule à transformer en case à cocher

convertir chiffre en lettre sur excel 2016

Macro pour ouvrir fichier excel

Votre réponse

Discussions similaires