Microsoft 365 Couleur Police sur grand nombre de cellules

E

eric72

XLDnaute Accro
Bonjour à tous,
Je rencontre un souci pour changer la couleur de la police d'un grand nombre de cellules en fonction de la valeur d'un grand nombre de cellules également, je m'explique:
- j'ai un planning avec huit equipes et huit tranche d'heures par équipe, j'ai des cellules (exemple e13) dans lesquelles je mets un "x" pour changer la couleur de police d'une plage (exemple h8:m14), jusque là pas de souci ou avec une MFC ou avec une macro qui se déclenche avec le
Private Sub Worksheet_Change(ByVal Target As Range), le problème est que, compte tenu du nombre de plages concernées cela devient lourd mais j'imagine qu'il y a une solution générique pour traiter toutes les cellules avec un "x" (exemple e13,q13,ac13) et cela pour toutes les tranches d'heures mais je ne trouve pas mon bonheur, l'un d'entre vous a-t-il la solution magique?
Merci beaucoup
 

Pièces jointes

  • test couleur.xlsm
    331.9 KB · Affichages: 6
Solution
TooFatBoy
Proposition :
VB: 
Private Sub Worksheet_Change(ByVal Target As Range)
'
Dim MaCellule As Range
Dim MaValeur As Integer

    If Target.Cells.Count <> 1 Then Exit Sub                    ' Si plus d'une cellule modifiée, on sort
    If Target.Row < 13 Or Target.Column > 65 Then Exit Sub      ' Si on est au-dessus ou à droite du tableau, on sort
    If Target.Column Mod 12 <> 5 Then Exit Sub                  ' Si on n'est pas dans la bonne colonne, on sort
    If (Target.Row + 1) Mod 7 > 1 Then Exit Sub                 ' Si on n'est pas sur la bonne ligne, on sort

    Set MaCellule = Target.Offset(-((Target.Row + 1) Mod 7), 0) ' On détermine la première des deux cellules (exemple : E13 pour la plage E13:14)

    MaValeur =...
Trier par date Trier par votes
TooFatBoy

TooFatBoy

XLDnaute Barbatruc
Bonjour,

Une proposition :
VB: 
Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.Cells.Count <> 1 Then Exit Sub
    If Target.Column < 5 Or Target.Column > 65 Or (Target.Column - 5) Mod 12 <> 0 Then Exit Sub
    If Target.Row < 13 Or Target.Row > 454 Or (Target.Row - 13) Mod 7 <> 0 Then Exit Sub
    If Target.Value = "x" Then
        Target.Offset(-5, 3).Resize(7, 6).Font.Color = RGB(0, 176, 80)
    Else
        Target.Offset(-5, 3).Resize(7, 6).Font.Color = RGB(0, 0, 0)
    End If
End Sub
 
Vote positif 0 Vote négatif
E

eric72

XLDnaute Accro
TooFatBoy à dit:
Bonjour,

Une proposition :
VB: 
Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.Cells.Count <> 1 Then Exit Sub
    If Target.Column < 5 Or Target.Column > 65 Or (Target.Column - 5) Mod 12 <> 0 Then Exit Sub
    If Target.Row < 13 Or Target.Row > 454 Or (Target.Row - 13) Mod 7 <> 0 Then Exit Sub
    If Target.Value = "x" Then
        Target.Offset(-5, 3).Resize(7, 6).Font.Color = RGB(0, 176, 80)
    Else
        Target.Offset(-5, 3).Resize(7, 6).Font.Color = RGB(0, 0, 0)
    End If
End Sub
Cliquez pour agrandir...
Bonjour TooFatBoy,

Merci beaucoup pour la réponse, cependant j'ai une question si je souhaite faire la même chose avec la couleur noire en cochant la case du dessous (exemple e14), je ne peux pas cumuler un autre code dans
VB: 
Private Sub Worksheet_Change(ByVal Target As Range)
à moins que!!!
Pour info je ne peux pas ouvrir le fichier joint
Merci beaucoup
 
Vote positif 0 Vote négatif
TooFatBoy

TooFatBoy

XLDnaute Barbatruc
eric72 à dit:
si je souhaite faire la même chose avec la couleur noire en cochant la case du dessous (exemple e14), je ne peux pas cumuler un autre code
Cliquez pour agrandir...
C'est bizarre, mais je m'attendais un peu à cette question... 😅

Il faudrait définir tes besoins complets.
- texte vert quand on met un "x" dans E13,
- texte noir quand on met un "x" dans E14,
- que faire quand il n'y a aucun "x" ???
- que faire quand il y a deux "x" ???
 
Vote positif 0 Vote négatif
E

eric72

XLDnaute Accro
TooFatBoy à dit:
C'est bizarre, mais je m'attendais un peu à cette question... 😅

Il faudrait définir tes besoins complets.
- texte vert quand on met un "x" dans E13,
- texte noir quand on met un "x" dans E14,
- que faire quand il n'y a aucun "x" ???
- que faire quand il y a deux "x" ???
Cliquez pour agrandir...
Tu commences à bien me connaitre 🤣
si aucun "x", alors couleur d'origine (rouge)
si "x" en (exemple e13), alors vert
si "x" en (exemple e14), alors noir
si on supprime "x" en e14, alors vert
J'espère être assez explicite pour une fois!!!
Merciiiiiii
 
Vote positif 0 Vote négatif
TooFatBoy

TooFatBoy

XLDnaute Barbatruc
Proposition :
VB: 
Private Sub Worksheet_Change(ByVal Target As Range)
'
Dim MaCellule As Range
Dim MaValeur As Integer

    If Target.Cells.Count <> 1 Then Exit Sub                    ' Si plus d'une cellule modifiée, on sort
    If Target.Row < 13 Or Target.Column > 65 Then Exit Sub      ' Si on est au-dessus ou à droite du tableau, on sort
    If Target.Column Mod 12 <> 5 Then Exit Sub                  ' Si on n'est pas dans la bonne colonne, on sort
    If (Target.Row + 1) Mod 7 > 1 Then Exit Sub                 ' Si on n'est pas sur la bonne ligne, on sort

    Set MaCellule = Target.Offset(-((Target.Row + 1) Mod 7), 0) ' On détermine la première des deux cellules (exemple : E13 pour la plage E13:14)

    MaValeur = -(MaCellule.Value = "x") - 2 * (MaCellule.Offset(1, 0).Value = "x")
    Select Case MaValeur
    Case 0
        MaCellule.Offset(-5, 3).Resize(7, 6).Font.Color = RGB(255, 0, 0)    ' Rouge
    Case 1
        MaCellule.Offset(-5, 3).Resize(7, 6).Font.Color = RGB(0, 176, 80)   ' Vert
    Case 2
        MaCellule.Offset(-5, 3).Resize(7, 6).Font.Color = RGB(0, 0, 0)      ' Noir
    Case 3
        MaCellule.Offset(-5, 3).Resize(7, 6).Font.Color = RGB(0, 0, 255)    ' Bleu
    End Select

End Sub
 
Vote positif 0 Vote négatif
Solution
E

eric72

XLDnaute Accro
TooFatBoy à dit:
Proposition :
VB: 
Private Sub Worksheet_Change(ByVal Target As Range)
'
Dim MaCellule As Range
Dim MaValeur As Integer

    If Target.Cells.Count <> 1 Then Exit Sub                    ' Si plus d'une cellule modifiée, on sort
    If Target.Row < 13 Or Target.Column > 65 Then Exit Sub      ' Si on est au-dessus ou à droite du tableau, on sort
    If Target.Column Mod 12 <> 5 Then Exit Sub                  ' Si on n'est pas dans la bonne colonne, on sort
    If (Target.Row + 1) Mod 7 > 1 Then Exit Sub                 ' Si on n'est pas sur la bonne ligne, on sort

    Set MaCellule = Target.Offset(-((Target.Row + 1) Mod 7), 0) ' On détermine la première des deux cellules (exemple : E13 pour la plage E13:14)

    MaValeur = -(MaCellule.Value = "x") - 2 * (MaCellule.Offset(1, 0).Value = "x")
    Select Case MaValeur
    Case 0
        MaCellule.Offset(-5, 3).Resize(7, 6).Font.Color = RGB(255, 0, 0)    ' Rouge
    Case 1
        MaCellule.Offset(-5, 3).Resize(7, 6).Font.Color = RGB(0, 176, 80)   ' Vert
    Case 2
        MaCellule.Offset(-5, 3).Resize(7, 6).Font.Color = RGB(0, 0, 0)      ' Noir
    Case 3
        MaCellule.Offset(-5, 3).Resize(7, 6).Font.Color = RGB(0, 0, 255)    ' Bleu
    End Select

End Sub
Cliquez pour agrandir...
Re
Top de chez top comme d'habitude, merci beaucoup une nouvelle fois et bonne digestion 🙏
Bonne soirée
 
Vote positif 0 Vote négatif
TooFatBoy

TooFatBoy

XLDnaute Barbatruc
Remarque bien que ce n'est pas parfait !

Par exemple, si on sélectionne toutes les cellules du tableau et qu'on appuie sur <Suppr>, toutes les cellules de type E13:E14 sont alors vides, mais la couleur du texte des cellules associées (H8:H14) ne sont pas modifiées en conséquence... :(
 
Vote positif 0 Vote négatif
E

eric72

XLDnaute Accro
TooFatBoy à dit:
Remarque bien que ce n'est pas parfait !

Par exemple, si on sélectionne toutes les cellules du tableau et qu'on appuie sur <Suppr>, toutes les cellules de type E13:E14 sont alors vides, mais la couleur du texte des cellules associées (H8:H14) ne sont pas modifiées en conséquence... :(
Cliquez pour agrandir...
par contre je viens de m'apercevoir d'un autre problème, lorsque je saisie une semaine en aa4, je récupère le planning qui a été archivé auparavant, du coup les "X" apparaissent bien mais les couleurs ne sont plus adaptées, l'événement Change ne se déclenche pas, aie!!!
 
Vote positif 0 Vote négatif

Discussions similaires

D
  • Question
Microsoft 365 Code VBA police de couleur
2
Réponses
17
Affichages
699
sylvanu
sylvanu
M
  • Question
XL 2013 changement de couleur de police qd cellule modifiée
Réponses
10
Affichages
297
michel.dupont
M
Usine à gaz
  • Résolu(e)
XL 2021 Compter le nombre de cellules qui contiennent la date d'aujourd'hui
2
Réponses
17
Affichages
679
job75
job75
B
  • Résolu(e)
XL 2016 Retirer une tranche horaire pour calcul de temps
Réponses
9
Affichages
433
Phil69970
Phil69970
F
  • Question
XL 2016 copie de doublons sur nouvel onglet
2
Réponses
22
Affichages
597
finarobert
F
N
  • Question
Microsoft 365 Fonction si avec une valeur différente de 1
Réponses
3
Affichages
184
NILS19
N
D
  • Résolu(e)
Microsoft 365 NB.SI sur cellules filtrées uniquement
Réponses
2
Affichages
180
dargoll
D
W
  • Question
XL 2016 Coloration ou pas des cellules voisines de la colonne B
Réponses
2
Affichages
221
Webperegrino
W
D
  • Question
Microsoft 365 formules avec double conditions préalables et plusieurs conditions selon des niveaux de délégations
Réponses
2
Affichages
201
Daniel200666
D
Z
  • Question
Microsoft 365 Mise en forme de tableau et répétition de formule
Réponses
2
Affichages
209
DJunqueira
D

Membres actuellement en ligne

9 membres et 73 invités.

Partager cette page

Tutos vidéos

Power Query : Ajouter des requêtes (Excel et Power BI)
Créez votre première fonction LAMBDA dans Excel en 3 étapes!
LAMBDA, l’arme secrète de Microsoft pour Excel !
Office Insider - Découvrez les nouveautés Excel avant tout le monde

Statistiques des forums

Discussions
312 329
Messages
2 087 330
Membres
103 519
dernier inscrit
Thomas_grc11