Cellules clignotent si date > ou = à aujourd'hui
#1
Débutant XLPages

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.

 

 

Hors Ligne
Rapport   Haut 

Re: Cellules clignotent si date > ou = à aujourd'hui
#2
Webmestre

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 smiley

 

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
Image redimensionnée
Le Webmaster

La réponse vous satisfait ? Merci de revenir solder le sujet en [résolu], voir ce lien
Hors Ligne
Rapport   Haut 

Re: Cellules clignotent si date > ou = à aujourd'hui
#3
Webmestre

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.

La colonne à surveiller est la colonne B en Feuille1 (à adapter dans le code : voir les commentaires)

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


En espérant que ça puisse t'être utile...

Bien cordialement,

Pièce jointe:
xls PourXypho75.xls   [ Taille: 48.00 Ko - Téléchargements: 450 ]

Didier_mDF
Image redimensionnée
Le Webmaster

La réponse vous satisfait ? Merci de revenir solder le sujet en [résolu], voir ce lien
Hors Ligne
Rapport   Haut 


Vous pouvez voir les sujets.
Vous ne pouvez pas débuter de nouveaux sujets.
Vous ne pouvez pas répondre aux contributions.
Vous ne pouvez pas éditer vos contributions.
Vous ne pouvez pas effacez vos contributions.
Vous ne pouvez pas ajouter de nouveaux sondages.
Vous ne pouvez pas voter en sondage.
Vous ne pouvez pas attacher des fichiers à vos contributions.
Vous ne pouvez pas poster sans approbation.

[Recherche avancée]


Qui consulte actuellement ce sujet ?   1 Utilisateur(s) anonymes