Cellules clignotent si date > ou = à aujourd'hui | ||
---|---|---|
Inscription: 16/11/2014
Messages:
1
Système d'exploitation: PC Version Excel utilisée: 2010 |
Posté le : 16-11-2014 23h24
Bonsoir,
Dans mon tableur, je souhaiterais que toutes les cellules d'une même colonne se mettent à clignoter si la date de celles-ci est plus grande ou égale à AUJOURDHUI()
En avance, merci beaucoup pour votre précieuse aide.
|
|
|
Re: Cellules clignotent si date > ou = à aujourd'hui | ||
---|---|---|
Inscription: 18/05/2006
De Saône-et-Loire (71)
Messages:
1539
Système d'exploitation: PC Version Excel utilisée: 97, 2000, 2002, 2003, 2007, 2010, 2013, 2016 et 365 |
Posté le : 17-11-2014 21h57
Bonsoir Xypho75, bienvenu sur XLpages.com
Si tu n'as pas obtenu réponse d'ici là, je repasserai demain soir pour tenter de te fournir une proposition... (manque de dispo ce soir)
Bien cordialement, Didier_mDF
Le Webmaster La réponse vous satisfait ? Merci de revenir solder le sujet en [résolu], voir ce lien |
|
|
Re: Cellules clignotent si date > ou = à aujourd'hui | ||
---|---|---|
Inscription: 18/05/2006
De Saône-et-Loire (71)
Messages:
1539
Système d'exploitation: PC Version Excel utilisée: 97, 2000, 2002, 2003, 2007, 2010, 2013, 2016 et 365 |
Posté le : 18-11-2014 21h25
Bonsoir Xypho75, le Forum,
Je reviens donc avec une proposition de solution... voir pièce jointe et code ci-dessous. J'ai utilisé le code VBA suivant :
DANS LE MODULE DE CODE DE L'OBJET THISWORKBOOK
Option Explicit
'----------------------------------------------------------------------------- ' Auteur : Didier FOURGEOT (myDearFriend!) - www.mdf-xlpages.com ' Date : 18/11/2014 ' Sujet : Cellules et Alertes clignotantes '----------------------------------------------------------------------------- Private Sub Workbook_Open() '-------------------------------- 'Surveiller quelle colonne et dans quelle feuille ? ... A ADAPTER! Set FeuilCible = Sheets("Feuil1") nColCible = 2 '-------------------------------- 'Lance le clignotement à l'ouverture si condition remplie If ActiveSheet Is FeuilCible Then GoClign End If End Sub Private Sub Workbook_BeforeClose(Cancel As Boolean) 'Interrompt le clignotement éventuel avant fermeture StopClign End Sub Private Sub Workbook_Deactivate() 'Interrompt le clignotement éventuel si le classeur n'est plus le classeur actif StopClign End Sub Private Sub Workbook_SheetActivate(ByVal Sh As Object) 'Clignotement à l'activation de la feuille si condition remplie If Sh Is FeuilCible Then GoClign Else StopClign End If End Sub Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range) 'Clignotement sur modification de la feuille si condition remplie If Sh Is FeuilCible Then GoClign End If End Sub
DANS UN MODULE DE CODE STANDARD (Ex: Module1)
Option Explicit
'----------------------------------------------------------------------------- ' Auteur : Didier FOURGEOT (myDearFriend!) - www.mdf-xlpages.com ' Date : 18/11/2014 ' Sujet : Cellules et Alertes clignotantes '----------------------------------------------------------------------------- Public FeuilCible As Worksheet Public nColCible As Integer Dim PlageCible As Range Dim Temps As Date Public Sub GoClign() Dim R As Range, ColSource As Range, PlageSource As Range, PlageC As Range, PlageF As Range StopClign 'Définition de la colonne à surveiller... (Voir dans Workbook_Open()) Set ColSource = FeuilCible.Columns(nColCible) 'Redéfinit la plage dite "clignotante" Set PlageCible = Nothing On Error Resume Next Set PlageC = ColSource.SpecialCells(xlCellTypeConstants, 1) 'Dates = Constantes Set PlageF = ColSource.SpecialCells(xlCellTypeFormulas, 1) 'Dates = Formules Set PlageSource = PlageC If Not PlageSource Is Nothing Then Set PlageSource = Union(PlageC, PlageF) Else Set PlageSource = PlageF End If On Error GoTo 0 If PlageSource Is Nothing Then Exit Sub For Each R In PlageSource If IsDate(R.Value) Then If R.Value >= Date Then If PlageCible Is Nothing Then Set PlageCible = R Else Set PlageCible = Union(PlageCible, R) End If End If End If Next R If Not PlageCible Is Nothing Then Clign True End Sub Private Sub Clign(Optional vInit As Boolean = False) Static NbMax As Byte 'Programmation de l'évènement toutes les secondes Temps = Now + TimeValue("00:00:01") NbMax = IIf(vInit, 0, NbMax + 1) If NbMax < 10 Then 'Nbre de cycles maximum (A ADAPTER !!) Application.OnTime Temps, "Clign" 'Affiche l'alerte ou la fait disparaître (alternativement) With PlageCible .Interior.ColorIndex = IIf(.Interior.ColorIndex = xlNone, 3, xlNone) End With Else StopClign 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 PlageCible.Interior.ColorIndex = xlNone On Error GoTo 0 End Sub
Didier_mDF
Le Webmaster La réponse vous satisfait ? Merci de revenir solder le sujet en [résolu], voir ce lien |
|
|