XL 2010 Couleur VBA

  • Initiateur de la discussion Initiateur de la discussion DIDPROJ
  • Date de début Date de début

Boostez vos compétences Excel avec notre communauté !

Rejoignez Excel Downloads, le rendez-vous des passionnés où l'entraide fait la force. Apprenez, échangez, progressez – et tout ça gratuitement ! 👉 Inscrivez-vous maintenant !

DIDPROJ

XLDnaute Nouveau
Bonjour à tous,

J'ai une question. J'ai fait un planning pour ma société.
Lorsque je rentre des horaires dans les colonnes H et I , il s'affiche par macro la plage horaire avec le nom du déplacement.
La couleur de la plage horaire correspond à la couleur du nom de la personne dans la colonne B.

Pour mettre les couleurs à jour il faut que je clique sur le bouton couleur.

Par contre il n'y a que les couleurs pour la date du lundi qui se mettent à jour. Je n'arrive pas a appliquer cette fonction à l'ensemble de mon tableau.

Pouvez vous m'aider sur ce point : je voudrais que l'ensemble des couleurs des plages horaires de mon tableau correspondent à la couleur des noms correspondant.
Il y a déjà une macro dans le module 1 que j'essaye de modifier mais en vain et je vous joins mon fichier.

D'avance merci à tous
 

Pièces jointes

Bonjour DidProj,
Evidemment quand on fait :
VB:
 If .Cells(j, 2) = "" Then Exit Sub
et que pour le mardi la cellule B est vide puisque la date est en A, on sort de la Sub. Donc on ne traite que le lundi. 😉
En PJ un essai.
J'en ai profité pour limiter le nombre de lignes à traiter en essayant d'évaluer le nombre de lignes en tenant compte des jours et de l'entête.
Et j'ai aussi accéléré en sautant tous les IF si la cellule en B est vide.
 

Pièces jointes

Bonjour DIDPROJ

Il faut TOUJOURS se mefier des cellules fusionnees. J'ai supprime une ligne fusionnee qui ne servait a rien dans le tableau a chaque date et adapte le code :
VB:
Sub couleurs_noms()
    Dim j As Long, k As Long
    Application.ScreenUpdating = False
    With Sheets("Planning")
        For j = 11 To 10000
            For k = 10 To 34
                If .Cells(j, 1) = "" And .Cells(j, 2) = "" Then Exit Sub
                If .Cells(j, 2) = "Fabrice FONTAINE" And .Cells(j, k).Interior.ColorIndex <> xlNone Then
                    .Cells(j, 2).Font.ColorIndex = 5
                    .Cells(j, k).Interior.ColorIndex = 5
                ElseIf .Cells(j, 2) = "Stéphane POCHET" And .Cells(j, k).Interior.ColorIndex <> xlNone Then
                    .Cells(j, 2).Font.ColorIndex = 44
                    .Cells(j, k).Interior.ColorIndex = 44
                ElseIf .Cells(j, 2) = "Christophe ANSELIN" And .Cells(j, k).Interior.ColorIndex <> xlNone Then
                    .Cells(j, 2).Font.ColorIndex = 4
                    .Cells(j, k).Interior.ColorIndex = 4
                ElseIf .Cells(j, 2) = "Isabelle POCHET" And .Cells(j, k).Interior.ColorIndex <> xlNone Then
                    .Cells(j, 2).Font.ColorIndex = 7
                    .Cells(j, k).Interior.ColorIndex = 7
                ElseIf .Cells(j, 2) = "Françoise GALLET" And .Cells(j, k).Interior.ColorIndex <> xlNone Then
                    .Cells(j, 2).Font.ColorIndex = 46
                    .Cells(j, k).Interior.ColorIndex = 46
                ElseIf .Cells(j, 2) = "Didier MARQUOIS" And .Cells(j, k).Interior.ColorIndex <> xlNone Then
                    .Cells(j, 2).Font.ColorIndex = 29
                    .Cells(j, k).Interior.ColorIndex = 29
                End If
            Next k
        Next j
    End With
    Application.ScreenUpdating = True
End Sub
 

Pièces jointes

- Navigue sans publicité
- Accède à Cléa, notre assistante IA experte Excel... et pas que...
- Profite de fonctionnalités exclusives
Ton soutien permet à Excel Downloads de rester 100% gratuit et de continuer à rassembler les passionnés d'Excel.
Je deviens Supporter XLD

Discussions similaires

Réponses
7
Affichages
116
Réponses
4
Affichages
97
Réponses
1
Affichages
358
Réponses
12
Affichages
212
Réponses
2
Affichages
102
Retour