impression couleur d'une cellule en fonction de la couleur d'une autre cellule

**Daniel.C** · 19/09/2012, 12h09

Bonjour,

Tu pourrais peut-être régler le problème avec une mise en forme conditionnelle ?
Sélectionne la plage A13:Q43
Entre une première règle avec la formule :
=JOURSEM($A13;2)>5
mise en forme : gris
Entre une seconde règle avec la formule :
=JOURSEM($A13)=4
mise en forme : rouge.
Si tu préfères une macro, dis-le.

**facteur** · 19/09/2012, 12h40

et moi qui galerait avec la MFC (mise ne forme conditionnelle), car le format des dates m'empechait d'aboutir aux resulats. Et dire qu'il suffisait d'indiquer les jour de semaine..pas con..

Daniel, je ne te cache pas que je passerais bien par une macro car ensuite, j'aurais voulu, toujours dans cette plage A13:Q43 et uniquement sur les lignes coloriées qui contiennent les jours de semaines mercredi, samedi et dimanche :
supprimer le contenu des cellules des colonnes D et E (D13 à E43)
supprimer le contenu des cellules des colonnes G et H (G13 à H43)
supprimer le contenu des cellules des colonnes J et K (J13 à K43)
supprimer le contenu des cellules des colonnes M; N; O; P; Q (M13 à Q43)

**Daniel.C** · 19/09/2012, 13h52

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
Sub facteur()
    'Réf.120919.xlsm
    Dim C As Range
    With Sheets("Feuil1")
        For Each C In .Range(.[A13], .Cells(.Rows.Count, 1).End(xlUp))
            If Application.Weekday(C.Value) = 4 Then
                C.Resize(, 17).Interior.ColorIndex = 15
                Intersect(C.Row, Union(.[D:E], .[G:H], .[J:K], .[M:Q])).Delete xlShiftToLeft
            ElseIf Application.Weekday(C.Value, 2) > 5 Then
                C.Resize(, 17).Interior.ColorIndex = 3
                Intersect(C.Row, Union(.[D:E], .[G:H], .[J:K], .[M:Q])).Delete xlShiftToLeft
            End If
        Next C
    End With
End Sub

**facteur** · 19/09/2012, 14h31

Daniel,
Lorsque j'execute la macro, j'ai un message d'erreur ("erreur de compilation, Incompatibilité de type") sur la ligne suivante :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

Intersect(C.Row, Union(.[D:E], .[G:H], .[J:K], .[M:Q])).Delete xlShiftToLeft

**Daniel.C** · 19/09/2012, 15h06

Au temps pour moi, ça m'apprendra à tester.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
Sub facteur()
    'Réf.120919.xlsm
    Dim C As Range
    With Sheets("Feuil1")
        For Each C In .Range(.[A13], .Cells(.Rows.Count, 1).End(xlUp))
            If Application.Weekday(C.Value) = 4 Then
                C.Resize(, 17).Interior.ColorIndex = 15
                Intersect(C.EntireRow, Union(.[D:E], .[G:H], .[J:K], .[M:Q])).Delete xlShiftToLeft
            ElseIf Application.Weekday(C.Value, 2) > 5 Then
                C.Resize(, 17).Interior.ColorIndex = 3
                Intersect(C.EntireRow, Union(.[D:E], .[G:H], .[J:K], .[M:Q])).Delete xlShiftToLeft
            End If
        Next C
    End With
End Sub

**facteur** · 19/09/2012, 15h43

daniel,
heu..ton programme doit comporter quelques erreur car lorsque je lance la macro, elle bug et affiche un message d'erreur :" erreur d'éxecution 13 Incompatiblité de type".
Et lorsque j'ouvre la macro, la ligne

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

If Application.Weekday(C.Value) = 4 Then

est surlignée en jaune.

Au niveau de la feuill Excel, elle présente des anomalies, au niveau des lignes mercredi, samedi, dimanche ; ce sont les cellules B13 à C43 qui sont supprimer alors que je voulais que ce soit les cellules ci-dessous qui soient supprimée
D13 à E43
G13 à H43
J13 à K43
M13 à Q43

**Daniel.C** · 19/09/2012, 17h02

Pour moi, c'est correct. Les colonnes restantes sont B, C, F, I et L. Seulement, suite à la suppression, les cellules non supprimées se trouvent décalées vers la gauche. Regarde le classeur joint et exécute la macro. J'ai renseigné chaque cellule avec la lettre de sa colonne avant exécution de la macro.

**facteur** · 19/09/2012, 17h32

j crois comprend ce qui se passe,
la macro retire 2 fois le programme, ce qui crée des erreurs.
j'ai l'impression qu 'elle ne s'arrete pas lorsque 'elle arrive a la derniere ligne non vide du tableau.
La ligne :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

For Each C In .Range(.[A13], .Cells(.Rows.Count, 1).End(xlUp))

correspond elle bien à la derniere ligne non vide tu tableau ?

**Daniel.C** · 19/09/2012, 17h49

Oui, pourquoi ? tu as autre chose en colonne A ?

**facteur** · 19/09/2012, 17h57

Daniel,
je suis perdu,
je te joins le fichier avec ton programme intitulé "couleur".
Lorsque tu le lanceras , tu verras que le fichier comporte des erreurs.
Au fait dans la colonne A , j'ai des formules dans les colonne B, C, F, I, L

**Daniel.C** · 19/09/2012, 19h13

Oui. A partir du moment où tu supprimes les cellules J et K, la cellule L est en erreur, donc la cellule C également ainsi que la cellule B. Fias les suppressions manuellement sur une ligne et tu as le constater.

Puisque les formules n'ont plus de sens, je peux remplacer les formules par leur valeur avant de faire les suppressions, qu'est-ce que tu en penses ?

**facteur** · 20/09/2012, 10h27

Bonjour Daniel,
je comprends mieux l'origine du problème.

Pour ce qui est de remplacer les formules par leur valeur, tu souhaites donc remplacer, par exemple, la formule en B13 = (C13-ENT(C13))*24 par la valeur 2,5.
je serais donc ensuite obligé de rentrer manuellement les formules dans les colonne B, C, F, I, L.
Si c'est la cas, je préferais une autre solution :

Comme tu as pu le constater les données supprimées dans les cellules :
D13 à E43
G13 à H43
J13 à K43
M13 à Q43
sont des "heues:minutes"
je préferais donc remplacer ces "heures : minutes" par "00:00". Ainsi, je n'aurais plus de messages d'erreur et les formules seront toujours d'actualités..

Est ce faisable ?..

**Daniel.C** · 20/09/2012, 11h23

Bonjour,

Les colonnes M:O sont des euros. Je les ai également remis à 0 :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
Sub couleur()
 
 
    Dim C As Range
    With Sheets("Feuil1")
 
        For Each C In .Range(.[A13], .Cells(.Rows.Count, 1).End(xlUp))
            If Application.Weekday(C.Value) = 4 Then
                C.Resize(, 17).Interior.ColorIndex = 15
                Intersect(C.EntireRow, Union(.[D:E], .[G:H], .[J:K], .[M:Q])).Value = #12:00:00 AM#
            ElseIf Application.Weekday(C.Value, 2) > 5 Then
                C.Resize(, 17).Interior.ColorIndex = 3
                Intersect(C.EntireRow, Union(.[D:E], .[G:H], .[J:K], .[M:Q])).Value = #12:00:00 AM#
            End If
        Next C
        .[P:Q].NumberFormat = "hh:mm"
    End With
End Sub

**facteur** · 20/09/2012, 12h13

On a ( enfin tu as...

) résolue le problème des erreurs..
Mais poussons la perfection un peu plus loin..

1) Ne peut on pas laisser les cellules vides des champs P13 : Q43 et Q13:Q43
(ce n'est pas de champs monétaire donc avoir des 0€ ça fait désordre..

)

2) Je rend compte que j'ai oublié de te dire que ce tableau est mensualisé.
En fin de mois, je le copie sur un autre onglet (toujours sur la même feuille) et le renomme .
Sur ta macro, j'ai remplacé

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

With Sheets("Feuil1")

par

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

With ActiveSheet

.
Mais lorsque je relance la macro, je me rend compte que le nouveau tableau garde les colories de l'ancien tableau :
par exemple, sur le mois de décembre, la ligne A13 est le samedi 1er décembre. Je lance la macro, tout fonctionne, la ligne se colorie en rouge avec tout le reste.
En fin de mois, je copie ce tableau sur un autre onglet. En A13, j'indique la date du 1er janvier 2013 qui est un mardi. Avant de lancer la macro, cette ligne est en rouge ( car elle provient de l'ancien tableau du mois de décembre).
Je lance de nouveau la macro, celle-ci fonctionne mais elle garde les lignes coloriés du mois de décembre.
Je me retrouve donc avec un tableau avec des lignes mardi en rouge.
Et ainsi de suite, pour les mois suivant

Nefaudrait il pas rajouter un userform (ou un autre module) que je lancerais avant de lancer ton programme.
Cet userform (ou autre module) effacerait les couleurs de toutes les lignes du tableau avant de lancer le programme...

**Daniel.C** · 20/09/2012, 14h58

J'espère n'avoir rien oublié :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
Sub couleur()
 
 
    Dim C As Range
    With ActiveSheet
        .[A13:Q43].Interior.ColorIndex = xlNone
        For Each C In .Range(.[A13], .Cells(.Rows.Count, 1).End(xlUp))
            If Application.Weekday(C.Value) = 4 Then
                C.Resize(, 17).Interior.ColorIndex = 15
                Intersect(C.EntireRow, Union(.[D:E], .[G:H], .[J:K], .[M:O])).Value = #12:00:00 AM#
                Intersect(C.EntireRow, .[P:Q]).Value = ""
            ElseIf Application.Weekday(C.Value, 2) > 5 Then
                C.Resize(, 17).Interior.ColorIndex = 3
                Intersect(C.EntireRow, Union(.[D:E], .[G:H], .[J:K], .[M:O])).Value = #12:00:00 AM#
                Intersect(C.EntireRow, .[P:Q]).Value = ""
            End If
        Next C
        .[P:Q].NumberFormat = "hh:mm"
    End With
End Sub

**facteur** · 20/09/2012, 17h12

tu as presque rien oublié..mais et oui il y a toujours un mais...

Lorsque je copie le tableau pour amorcer un nouveau mois..il m'est impossible de modifier les couleur du tableau (enlever la couleur rouge et grise) afin de le rendre vierge de couleur.
Je me retrouve donc avec un tableau que je ne peux malheureusement pas réutiliser..

Comme dis dans le précédent message,
Ne faudrait il pas rajouter un userform (ou un autre module) que je lancerais avant de lancer ton programme.
Cet userform (ou autre module) effacerait les couleurs de toutes les lignes du tableau avant de lancer le programme...

**Daniel.C** · 20/09/2012, 18h19

Quand tu lances la macro, les couleurs du tableau sont effacées, puis, les nouvelles couleurs sont appliquées.

**facteur** · 21/09/2012, 11h08

Bonjour Daniel,

Tout a fait : lorsque je lance la macro, les couleurs du tableau sont effacées, puis, les nouvelles couleurs sont appliquées.
Mais, en fin de mois, ce tableau sera copié pour commencer un nouveau mois. Et la, si je lance la macro sur ce nouveau tableau, les anciennes couleurs ne sont pas effacées. Elles restent sur le nouveau tableau, ce qui crée des un tableau avec des lignes de semaine (comme le mardi) coloriées en rouge.

**Daniel.C** · 21/09/2012, 11h23

Je ne comprends pas pourquoi; quel que soit le tableau, il est traité de la même façon. Peux-tu mettre un classeur en PJ ?

**facteur** · 21/09/2012, 12h49

daniel,
Je ne comprend plus rien. maintenant , ce n'est plus un problème de suppression de couleur mais de macro qui bug...

je vais essayer d'expliquer la problèmatique par étape ..

1) le tableau regroupe les cellule de A13:Q43.
La cellule A43 peut est vide lorsque le mois est à 30 jours et elle est contient la date du 31 lorsque le mois est à 31 jours.

2) Dans les cellules A46 à A50, il y a des annotations que j'avais cru bon de ne pas en parler

3)Que le tableau concerne un mois à 30 jours ou 31 jours et que je lance la macro, celle-ci bug.
- les lignes A45 et A46 se colorent en rouge.
- Sur ces lignes, dans les colonne DE, GH, JK, sont affichées des heures en format 12:00:00 AM.
- un message d'erreur apparait:
"Erreur d'éxécution "13". Incompatibilité de type".
- La ligne de code

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

 If Application.Weekday(C.Value) = 4 Then

est surlignée en jaune.
Ce bug est il du aux annotations sur les celles A46 à A50 ??

impression couleur d'une cellule en fonction de la couleur d'une autre cellule [XL-2003]

Macros et VBA Excel

Discussions similaires

Partager

Partager