Titre du sujet : Re: clignotement d une cellule d une ligne par myDearFriend! le 03/10/2009 16:38:00
Bonjour papycocol, le Forum,
A vrai dire, je te conseillerais plutôt de voir du côté des mises en forme conditionnelles, beaucoup plus légères et beaucoup plus simple à mettre en oeuvre... Le clignotement des cellules, même s'il ajoute un côté fun au classeur, reste du domaine gadget.
Cela dit, si tu souhaites absolument l'intégrer à ton oeuvre, alors voici une façon de faire utilisant la méthode OnTime (qui me semble la façon de faire la plus simple d'aborder le sujet) :
J'ai simplement repris et adapté pour l'occasion, le code qu'on retrouve dans le classeur exemple Cellules et alertes clignotantes (je t'invite également à consulter l'article traitant de la Méthode OnTime si tu veux en comprendre le fonctionnement).
Voir en pièce jointe le code suivant :
DANS LE MODULE DE CODE DE L'OBJET THISWORKBOOK
Option Explicit
' myDearFriend! - www.mdf-xlpages.com
Private Sub Workbook_Open()
'Lance le clignotement à l'ouverture
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)
If Not Application.Intersect(Target, Sh.Columns(4)) Is Nothing Then
StopClign
Clign
End If
End Sub
DANS UN MODULE DE CODE STANDARD (ex : Module1)
Option Explicit
' myDearFriend! - www.mdf-xlpages.com
Public LigneCible As Range
Dim Temps As Date
Public Sub Clign()
If CibleExiste Then
'Programmation de l'évènement toutes les secondes
Temps = Now + TimeValue("00:00:01")
Application.OnTime Temps, "Clign"
'Affiche l'alerte ou la fait disparaître (alternativement)
With LigneCible
.Interior.ColorIndex = IIf(.Interior.ColorIndex = 3, xlNone, 3)
End With
End If
End Sub
Public Sub StopClign()
On Error Resume Next
'Stoppe la gestion de l'évènement OnTime
Application.OnTime Temps, "Clign", , False
'Cache l'alerte
LigneCible.Interior.ColorIndex = xlNone
Set LigneCible = Nothing
End Sub
Public Function CibleExiste() As Boolean
If LigneCible Is Nothing Then
On Error Resume Next
With Sheets("Feuil1") 'A adapter... ici, on parle de Feuil1 et colonne 1
Set LigneCible = Intersect(.Columns(1).Find(1, LookIn:=xlValues).EntireRow, .UsedRange.Cells)
End With
End If
CibleExiste = Not LigneCible Is Nothing
End Function
Cordialement,
|