XL 2010 fond cellule clignotant → ajout paramètre police

[DAVAWAY]

Bonjour,
Pourriez vous m'apporter une aide sur la ligne de code que je ne parviens pas à compléter malgré mes tentatives.
La cellule "E6" clignote en rouge mais la valeur inscrite qui est transparente apparait à ce moment.
Je souhaite que lorsque la cellule clignote en rouge, que la police soit également basculée en rouge mais pour l'heure sans succès _ merci pour votre aide :

Option Explicit

Dim Temps As Variant
Public Sub Clign()
Temps = Now + TimeValue("00:00:01")
Application.OnTime Temps, "Clign"
With ThisWorkbook
'Fond
With .Sheets("Synthèse").Range("E6")
.Interior.ColorIndex = IIf(.Interior.ColorIndex = 3, xlNone, 3)
.Selection.Font = IIf(Color = -16776961, TintAndShade = 0)
End With
End With
End Sub

Public Sub StopClign()
On Error Resume Next
Application.OnTime Temps, "Clign", , False
On Error GoTo 0
With ThisWorkbook
'Fond
.Sheets("Synthèse").Range("E6").Interior.ColorIndex = xlNone
End With
End Sub

 

[Lone-wolf]

Bonjour DAVAWAY,

Option Explicit

  Dim Temps As Date
 
  Public Sub Clign()
  Temps = Now + TimeValue("00:00:01")
  Application.OnTime Temps, "Clign"
 
  'Fond
  With Sheets("Synthèse").Range("E6")
  .Interior.Color = IIf(.Interior.Color = vbRed, xlNone, vbRed)
  .Font.ColorIndex = IIf(.Font.ColorIndex = 3, xlNone, 3)
  End With

  End Sub

  Public Sub StopClign()
  On Error Resume Next
  Application.OnTime Temps, "Clign", , False
  On Error GoTo 0
  With Sheets("Synthèse").Range("E6")
  'Fond
  .Interior.Color = xlNone
  .Font.Color = vbBlack
  End With
  End Sub

 

[DAVAWAY]

Bonjour et merci Lone-wolf,

J'ai juste modifié la boucle dédiée à la police pour avoir avec la case blanche une police blanche :

.Font.ColorIndex = IIf(.Font.ColorIndex = 3, 2, 3)

Sais tu comment conditionner l'exécution du code (appui bouton macro affectée), car l'alerte couleur s'exécute automatiquement, je dois faire stopclign puis clign pour 'maîtriser' son exécution !?

Option Explicit
Private Sub Workbook_Open()
'Lance le clignotement à l'ouverture si la cellule E6 inférieure à 0
If Val(Sheets("Synthèse").Range("E6").Value) < 0 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("E6")) Is Nothing Then
Application.EnableEvents = True
'Lance ou stoppe le clignotement
If Val(Target.Value) < 0 Then Clign Else StopClign
End If
End Sub

 

[Lone-wolf]

Re

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
Application.EnableEvents = False

If Target.Count > 1 Then Exit Sub
If Not Intersect(Target, Range("E6")) Is Nothing Then
'Lance ou stoppe le clignotement
If Target.Value <= 0 Then Clign Else StopClign
End If
Application.EnableEvents = True

End Sub

 

[DAVAWAY]

Encore merci Lone-Wolf, je vais étudier ta reprise !
Je tentais désormais de déployer ce code à d'autres cellules (E7) mais je rencontre une erreur d'exécution 1004, je dois être à coté de la bonne écriture, merci d'avance :

Option Explicit

Dim Temps As Date
Public Sub Clign()
Temps = Now + TimeValue("00:00:01")
Application.OnTime Temps, "Clign"
'Fond
With Sheets("Synthèse").Range("E6" & "E7")
.Interior.Color = IIf(.Interior.Color = vbRed, xlNone, vbRed)
.Font.ColorIndex = IIf(.Font.ColorIndex = 3, 2, 3)
End With

End Sub

Public Sub StopClign()
On Error Resume Next
Application.OnTime Temps, "Clign", , False
On Error GoTo 0
With Sheets("Synthèse").Range("E6" & "E7")
'Fond
.Interior.Color = xlNone
.Font.Color = vbWhite
End With
End Sub

 

[Lone-wolf]

Re

Change Range("E6" & "E7") par Range("E6:E7"). Pour une plage de cellules

Dim plage As Range, cel As Range

set plage = .Range("a2:l100")

For each cel in plage
If cel.Value <= 0 Then Clign Else StopClign
next cel

Tu peux aussi faire par exemple
if Range("e6").Value <=0 Or Range("e7").Value <=0 Then Clign Else StopClign

 

[DAVAWAY]

merci Lone-Wolf, je ne parviens pas à maîtriser la séquence, pour l'heure, si en E6 ou E7 il y a une valeur <0 alors E6 ET E7 clignotent tous deux !

Option Explicit
Private Sub Workbook_Open()
'Lance le clignotement à l'ouverture si la cellule E6/E7 inférieure à 0
If Val(Sheets("Synthèse").Range("E6:E7").Value) < 0 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)
Application.EnableEvents = False

If Target.Count > 1 Then Exit Sub
If Not Intersect(Target, Range("E6:E7")) Is Nothing Then
'Lance ou stoppe le clignotement
If Target.Value <= 0 Then Clign Else StopClign
End If
Application.EnableEvents = True

End Sub

 

[Lone-wolf]

Re,

Regarde mon message précédent.

 

[DAVAWAY]

Merci Lone-wolf, tu pourrais faire la manipe dans le vba du fichier pour te rendre compte du contexte et pour m'aider à assimiler ce type de reprise vers laquelle je me suis pas encore aventuré ! merci pour ton aide précieuse !

 

[Lone-wolf]

Re

C'est compliqué parce-que tu utilise le timer Application.OnTime Temps pour 2 cellules, et je ne sais pas comment faire.

 

[DAVAWAY]

Merci quand même Lone-wolf, je vais essayer de trouver une solution de replis, en générant une cellule d'alerte - clignotante unique par onglet, sauf si tu as une ligne de code dédiée je te souhaite un bon après midi

 

[DAVAWAY]

Je ne sais pas si ce code peut-être adapter et se prête mieux pour être dupliquer à plusieurs cellules d'une même page..
Bien à toi,

Private Declare Function GetTickCount Lib "Kernel32" () As Long

Sub Minuterie(Milliseconde As Long)
Dim Arret As Long
Arret = GetTickCount() + Milliseconde
Do While GetTickCount() < Arret
DoEvents
Loop
End Sub

Sub Clignote(Cel1 As Range)
On Error GoTo Fin
'clignote si < 0
Do While Cel1.Value = "Asbsent sans justif."
Cel1.Interior.ColorIndex = 3
Minuterie 300
Cel1.Interior.ColorIndex = 0
Minuterie 300
Loop
Fin:
Cel1.Interior.ColorIndex = 0
End Sub


Private Sub Worksheet_Change(ByVal Target As Range)
Clignote Range("C7")
End Sub

 

[Lone-wolf]

Re,

J'ai enfin trouvé la solution.

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
    Application.EnableEvents = False
    'Lance le clignotement
    If [E6] <> "" Or [E7] <> "" Then Call Clign
    Application.EnableEvents = True
End Sub

Option Explicit
Public celA As Range, celB As Range, compteur As Long, deb As Date, t As Date

Public Sub Clign()

    With Sheets(1)
        Set celA = .Range("e6")
        Set celB = .Range("e7")
    End With


    With celA.Font
        For compteur = 1 To 10
            .ColorIndex = IIf(compteur Mod 2 = 0, xlNone, 3)
            celA.Interior.ColorIndex = IIf(compteur Mod 2 = 0, xlNone, 3)
            deb = Timer
            Do While Timer - deb < 0.5
                DoEvents
                If celA.Value > 0 Then celA.Font.ColorIndex = 0: celA.Interior.Color = xlNone: Exit Do
            Loop
        Next
    End With


    With celB.Font
        For compteur = 1 To 10
            .ColorIndex = IIf(compteur Mod 2 = 0, xlNone, 3)
            celB.Interior.ColorIndex = IIf(compteur Mod 2 = 0, xlNone, 3)
            deb = Timer
            Do While Timer - deb < 0.5
                DoEvents
                If celB.Value > 0 Then celB.Font.ColorIndex = 0: celB.Interior.Color = xlNone: Exit Do
            Loop
        Next
    End With
End Sub

 

[DAVAWAY]

Merci beaucoup Lone-wolf et surtout bravo
Pour l'heure je ne parviens pas à m'approprier ton codage, tu as fusionné le code thisworkbook et le module 'clignote' ?
J'abuse de ta gentillesse mais aurais tu le fichier avec le code amélioré intégré ?
Est il possible de remplacer
If [E6] <> "" Or [E7] <> "" Then Call Clign
par
If [E6] < 0 Or [E7] < 0 Then Call Clign
?
Encore merci,
David

 

[Lone-wolf]

Re David,

Private Sub Workbook_SheetChange est à mettre dans Thisworkbook,, si tu utilise la macro pour toutes les feuilles; sinon tu met les lignes de code dans le module de la feuille sous "Private Sub Worksheet_Change". Pour la 2ème question, bien sûr que tu peut.




Option Explicit
Public celA As Range, celB As Range, compteur As Long, deb As Date, t As Date

Public Sub Clign()xxxxxxEnd Sub est à mettre dans un module standard. En PJ, le classeur exemple avec une petite modification.