Mise en forme conditionnelle de date

Bonsoir j'essaie vainement depuis quelques jours de mettre en forme conditionnelle les dates de mon tableau

avec l’enregistreur de macro je peux definir une mise en forme conditionnelle que pour aux maximum +/- 1 mois autours de ma date :

 
Sub MFCdate()
Selection.FormatConditions.Add Type:=xlTimePeriod, DateOperator:= _
        xlThisMonth
    Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
    With Selection.FormatConditions(1).Interior
        .PatternColorIndex = xlAutomatic
        .Color = 255
        .TintAndShade = 0
    End With
    Selection.FormatConditions.Add Type:=xlTimePeriod, DateOperator:= _
        xlLastMonth
    Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
    With Selection.FormatConditions(1).Interior
        .PatternColorIndex = xlAutomatic
        .ThemeColor = xlThemeColorAccent6
        .TintAndShade = 0
    End With

    Selection.FormatConditions.Add Type:=xlTimePeriod, DateOperator:= _
        xlNextMonth
    Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
    With Selection.FormatConditions(1).Interior
        .PatternColorIndex = xlAutomatic
        .Color = 192
        .TintAndShade = 0
    End With
   Selection.FormatConditions(1).StopIfTrue = False
   Cells(10, 1).Select
End Sub

Mais j'aimerai pouvoir définir 2 ou 3 mois avant ma date,( le mois en cours et le mois suivant fonctionnant déjà)

Avez vous des idées pour réaliser ca?

Je reste a vos dispositions,

Edlede

Bonjour,

Une suggestion ....

Penser à coder le futur en premier et le passé en dernier

Prenons pour acquis qu'en cellule P1, il y a la formule "=Aujourdhui()" ... sinon, adapter à une cellule où ça conviendrait...

Sub MFCdate()
 Dim X As String
 Selection.FormatConditions.Delete      ' efface les MFC
 For i = Selection.Count To 2 Step -1   ' trouver la 1re cellule de la sélection
 Next i
 X = Selection(i).Address   ' l'incrire en X
 X = Replace(X, "$", "")    ' enlever les signes $ dans X
        ' aujourd'hui + 1 mois
 Selection.FormatConditions.Add Type:=xlExpression, Formula1:="=" & X & "<MOIS.DECALER($P$1;+1)"
 Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
 With Selection.FormatConditions(1).Interior
    .Pattern = xlSolid
    .PatternColorIndex = xlAutomatic
    .ThemeColor = xlThemeColorDark2
    .TintAndShade = -9.99786370433668E-02
    .PatternTintAndShade = 0
 End With

        ' aujourd'hui le mois présent
 Selection.FormatConditions.Add Type:=xlExpression, Formula1:="=" & X & "<MOIS.DECALER($P$1;-0)"
 Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
 With Selection.FormatConditions(1).Interior
    .Pattern = xlSolid
    .PatternColorIndex = xlAutomatic
    .ThemeColor = xlThemeColorAccent6
    .TintAndShade = 0.799981688894314
    .PatternTintAndShade = 0
 End With

            ' aujourd'hui - 1 mois
 Selection.FormatConditions.Add Type:=xlExpression, Formula1:="=" & X & "<MOIS.DECALER($P$1;-1)"
 Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
 With Selection.FormatConditions(1).Interior
    .Pattern = xlSolid
    .PatternColorIndex = xlAutomatic
    .ThemeColor = xlThemeColorAccent5
    .TintAndShade = 0.799981688894314
    .PatternTintAndShade = 0
 End With

            ' aujourd'hui - 2 mois
 Selection.FormatConditions.Add Type:=xlExpression, Formula1:="=" & X & "<MOIS.DECALER($P$1;-2)"
 Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
 With Selection.FormatConditions(1).Interior
    .Pattern = xlSolid
    .PatternColorIndex = xlAutomatic
    .ThemeColor = xlThemeColorAccent2
    .TintAndShade = 0.799981688894314
    .PatternTintAndShade = 0
 End With

             ' aujourd'hui - 3 mois
 Selection.FormatConditions.Add Type:=xlExpression, Formula1:="=" & X & "<MOIS.DECALER($P$1;-3)"
 Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
 With Selection.FormatConditions(1).Interior
     .Pattern = xlSolid
     .PatternColorIndex = xlAutomatic
     .ThemeColor = xlThemeColorAccent4
     .TintAndShade = 0.799981688894314
     .PatternTintAndShade = 0
 End With

 Cells(10, 1).Select
 End Sub

Gelinotte

Bonjour Gelinotte

Merci pour ta réponse si rapide

Je dois être un peu boulet mais je n'arrive pas appliquer ton code sur mon fichier

J'ai défini en cellule (AO;1) la formule =Aujourdhui()

Idéalement j'aimerai appliquer cette mise en forme conditionnelle à une seul colonne, mais la colonne ne se trouve jamais a la même place dans mes "Synthèses", et en plus son intitulée varie également d'une synthèse à l'autre.... ( voir colonne jaune de mes exemples).

je joins un fichier exemple .

Si tu as d'autre question je reste à disposition.

Bonjour,

AO1 est en matriciel

Il n'y a pas de raison, une formule bien ordinaire fait l'affaire.

Quel déclencheur de macro serait convivial ? Ou es-tu en mesure de contrôler ce bout là ?

Pour la colonne vagabonde, ce pourrait être la position du curseur n'importe où dans cette colonne au moment de l'activation de la macro. Je te reviens avec cela sous peu.

Gelinotte

Ha dsl la matricielle est une belle bêtise de ma part.

Pourrais tu me confirmer que la macro n est a exécuter qu une fois ? J ai l impression qu une fois exécuté les mises en formes conditionnelles restent sur la feuille.?

Merci

Bonjour,

edlede a écrit :

... Pourrais tu me confirmer que la macro n est a exécuter qu une fois ? J ai l impression qu une fois exécuté les mises en formes conditionnelles restent sur la feuille.? ...

À ma connaissance, qui n'est pas très étendue, les MFC sont appliquées de façon permanente ... jusqu'au prochain changement des conditions des MFC. Les MFC restent sur la feuille ... bien sûr ... n'est-ce pas le but des MFC ? ... Est-ce bien ce qui est désiré ... qu'elles restent en place ?

Pour répondre à ta question, oui, la macro n'est exécutée qu'une fois. Par contre, comme ce sont des MFC qui sont appliquées sur les cellules, les lendemains, les semaines prochaines, les mois suivants, les couleurs vont changées dans les cellules puisque la date en AO1 change pour la journée en cours et que les MFC font des comparaisons avec AO1.

Sélectionne une des cellules concernées, onglet "Accueil", bouton "Mise en forme conditionnelle", "Gérer les règles" ... c'est tout comme si tu les avais fait à la main ....

Gelinotte

Merci pour la confirmation j'attends éventuellement ton retour pour la macro a moins de 3 mois et encore merci à bientôt

Bonjour,

Pour l'instant, pas de d'activation de la macro automatiquement ... trop d'inconnus ... ou bien, ajouter un bouton (non imprimable) sur chaque feuille concernée.

Donc, sélectionne une cellule de la colonne sur laquelle tu désires appliquer les MFC. Puis, déclenche la macro (onglet Développeur, bouton Macro, MFCdate, bouton Exécuter).

Sub MFCdate()
 Dim X As String
 Dim DerLig As Integer
 Dim LaCel As String
 Dim Llig As Integer
 Dim Ccol As String
 Dim cCol2 As Integer
 Llig = 11

 With ActiveSheets
    cCol2 = ActiveCell.Column
    Ccol = Mid(ActiveCell.Address, 2, 1)
    DerLig = Range(Ccol & Rows.Count).End(xlUp).Row - 1
    Range(Cells(Llig, cCol2), Cells(DerLig, cCol2)).Select
End With

Selection.FormatConditions.Delete      ' efface les MFC
For i = Selection.Count To 2 Step -1   ' trouver la 1re cellule de la sélection
Next i
X = Selection(i).Address   ' l'incrire en X
X = Replace(X, "$", "")    ' enlever les signes $ dans X
       ' aujourd'hui + 1 mois
Selection.FormatConditions.Add Type:=xlExpression, Formula1:="=" & X & "<MOIS.DECALER($AO$1;+1)"
Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
With Selection.FormatConditions(1).Interior
    .Pattern = xlSolid
    .PatternColorIndex = xlAutomatic
    .ThemeColor = xlThemeColorDark2
    .TintAndShade = -9.99786370433668E-02  'couleur à adapter
    .PatternTintAndShade = 0
 End With

        ' aujourd'hui le mois présent
Selection.FormatConditions.Add Type:=xlExpression, Formula1:="=" & X & "<MOIS.DECALER($AO$1;-0)"
 Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
 With Selection.FormatConditions(1).Interior
    .Pattern = xlSolid
    .PatternColorIndex = xlAutomatic
    .ThemeColor = xlThemeColorAccent6
    .TintAndShade = 0.799981688894314  'couleur à adapter
    .PatternTintAndShade = 0
 End With

            ' aujourd'hui - 1 mois
Selection.FormatConditions.Add Type:=xlExpression, Formula1:="=" & X & "<MOIS.DECALER($AO$1;-1)"
 Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
 With Selection.FormatConditions(1).Interior
    .Pattern = xlSolid
    .PatternColorIndex = xlAutomatic
    .ThemeColor = xlThemeColorAccent5
    .TintAndShade = 0.799981688894314  'couleur à adapter
    .PatternTintAndShade = 0
 End With

            ' aujourd'hui - 2 mois
Selection.FormatConditions.Add Type:=xlExpression, Formula1:="=" & X & "<MOIS.DECALER($AO$1;-2)"
 Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
 With Selection.FormatConditions(1).Interior
    .Pattern = xlSolid
    .PatternColorIndex = xlAutomatic
    .ThemeColor = xlThemeColorAccent2
    .TintAndShade = 0.799981688894314  'couleur à adapter
    .PatternTintAndShade = 0
 End With

             ' aujourd'hui - 3 mois
Selection.FormatConditions.Add Type:=xlExpression, Formula1:="=" & X & "<MOIS.DECALER($AO$1;-3)"
 Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
 With Selection.FormatConditions(1).Interior
     .Pattern = xlSolid
     .PatternColorIndex = xlAutomatic
     .ThemeColor = xlThemeColorAccent4
     .TintAndShade = 0.799981688894314  'couleur à adapter
     .PatternTintAndShade = 0
 End With
 ActiveSheet.Cells(10, 1).Select
End Sub

Gelinotte

Super,

C'est parfait,

j'aurais une dernière question, est t'il possible pour aujoudhuis +1 mois de le passer à aujourdhuis+ "l'infinie" ou je fais à la porc en mettant ($AO$1;+1200) ?

' aujourd'hui + 1 mois
Selection.FormatConditions.Add Type:=xlExpression, Formula1:="=" & X & "<MOIS.DECALER($AO$1;+1)"
Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
With Selection.FormatConditions(1).Interior
    .Pattern = xlSolid
    .PatternColorIndex = xlAutomatic
    .ThemeColor = xlThemeColorDark2
    .TintAndShade = 0  'couleur à adapter
   .PatternTintAndShade = 0
 End With

Et je veux bien quelques explications sur

Selection.FormatConditions.Add Type:=xlExpression, Formula1:="=" & X & "<MOIS.DECALER($AO$1;+1)"
Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority

parceque j'ai pas compris la manoeuvre

Bonjour,

Remplacer : Formula1:="=" & X & "<MOIS.DECALER($AO$1;+1)"

Par : Formula1:="=" & X & ">=MOIS($AO$1)"

Le seul inconvénient, que j'espère acceptable, est que les cellules contenant des / réagissent à cette condition.

Je ne sais pas comment gérer cela.

J'apprends en même temps

Gelinotte

Je reprend ma demande car après quelques tests sur la sub

En fait j'ai inversé j'ai mis le code en +3mois, +2 mois, +1mois, aujourdhuis, -1 mois.

Du coup je voudrais si possible pour le -1mois que toutes les dates de la colonnes qui ont dépassé " aujourdhuis" depuis plus d'un mois soit conditionnée quelques soit le dépassement (1mois, 2 mois, 1 an ect...)

J'ai l'impression que plus j'explique plus c'est flou,....

Merci,

t'as poster entre deux ca répond a ma question :

Je test ca

Re merci

Ca avance bien, super

Par contre la dernière ligne n'est pas pris en compte je pense que le Step2 -1 loupe la dernière cellule du tableau, as tu une idée pour corriger cela?

Je ne comprend pas pourquoi l'absence de date ( case vide) est pour la macro une valeur comparable et renvoie une condition(>3mois). Bizarre, il devrait ignorer l'absence de caractères, si tu as une idée pour rendre mes cellules vides à nouveau vierge

a contrario, les cellules avec un / sont prise en compte mais avec une valeur >1 mois

La logique m'echappe

Merci,

J'ai résolu une partie des problèmes,

Pour les cellules contenant un "/"

Selection.FormatConditions.Add Type:=xlCellValue, Operator:=xlEqual, _
        Formula1:="=""/"""
    Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
    With Selection.FormatConditions(1).Interior
        .PatternColorIndex = xlAutomatic
        .ThemeColor = xlThemeColorDark1
        .TintAndShade = 0
  End With

Mais pour les cellules vides j'ai essayées

Selection.FormatConditions.Add Type:=xlCellValue, Operator:=xlEqual, _

Formula1:="="""""

Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority

With Selection.FormatConditions(1).Interior

.PatternColorIndex = xlAutomatic

.ThemeColor = xlThemeColorDark1

.TintAndShade = 0

End With

Et

Selection.FormatConditions.Add Type:=xlCellValue, Operator:=xlEqual, _

Formula1:="="" """

Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority

With Selection.FormatConditions(1).Interior

.PatternColorIndex = xlAutomatic

.ThemeColor = xlThemeColorDark1

.TintAndShade = 0

End With

Mais ca ne marche pas.

et je trouve pas comment allez jusqu’à la dernière ligne

A bientôt,

Bon j'ai finalement résolu le probleme de la dernière ligne

DerLig = Range(Ccol & Rows.Count).End(xlUp).Row

Je pense que le -1 est vrai si on part d'une ligne 0 or ici on par à ligne 11 ( enfin je penses...)

il ne manque plus que ces foutues cellules vides qui me pose problème.

Bonsoir,

Je remets mon fichier,

Mon problème reste toujours sur la mise en forme conditionnelle qui s'applique sur les "cellules vides".

Lancer One, la seconde partie du code, en commentaire, fonctionne pour l'instant parfaitement

Merci pour vos idées.

Bonjour,

Les règles ( Valeur de la cellule="" ) et ( Valeur de la cellule="/" ) fonctionnent. Mais, car il y a toujours un mais, après bien des tribulations, j'ai constaté que ces règles ne semblaient pas fonctionner jusqu'au moment où j'ai remarqué que certaines cellules avec des / contenaient des espaces devant ou derrière le / . La règle est pour des cellules contant / tout nu ... donc elle le s'appliquait pas car la comparaison donnait Faux. Idem pour les cellules qui semblaient vides; elles contenaient des espaces. Une espace est un caractère typographique ... d'où les comparaisons qui donnaient Faux.

Espérant que cela fera avancer ton projet.

Gelinotte

Du coup j'ai repris mes formules générant les dates pour insérer un"/" en cas de valeur vide aucun pb tous fonctionne bien merci encore gelinote pour toutes les informations

À bientôt sur le site