copier une couleur automatiquement

**annad** · 03/08/2009, 20h50

Bonjour,

Est-il possible de copier la couleur d'une cellule de la feuille 1 dans une cellule de la feuille 2?
Sachant que sur la feuille 1 la couleur se met automatiquement suivant ce que l'on met dans cette cellule. (c'est pas très clair)
Concrètement, si je mets par exemple "cp" dans une cellule de la feuille1, cette case où est inscrit "cp" se met en orange, ça c'est ok. Mais en m^me temps, sur la feuille 2, ce "cp" se note également automatiquement et je souhaite que la cellule se colore aussi en orange sur la feuille 2 mais je ne trouve pas comment.
J'ai en tout 7 couleurs différentes suivant les données introduites.
Il suffit peut-être de dire que la couleur de tel cellule est égale à la couleur de cette cellule mais bon, un peu dur pour moi...

Merci, Dan.

**wilfried_42** · 04/08/2009, 07h22

Bonjour

Quelle version d'excel ?, 2007 ? non 2003 je n'avais pas vu...
donc pour mettre une couleur différente pour 7 saisies, tu dois avoir une macro
tu dois la modifier, il faudrait pour cela soit ta macro avec le nom de la feuille, soit un exemple de ton fichier...

@ te lire

**annad** · 04/08/2009, 13h02

Bonjour, en fait voici pour la feuille1, elle s'appelle données patient.
Ca fonctionne très bien.
Ce que je voudrais, c'est que sur la feuille2, la couleur change également, suivant le même critère que sur la feuille1.
Mais la feuille2 est protégée en écriture et se rempli d'après la feuille1.
J'espère que c'est assez clair.
Merci, Dan.

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
21
22
23
24
25
26
27
28
Private Sub Worksheet_Change(ByVal Target As Range)
Dim Rg As Range
Set Rg = Range("F2:F139")
If Not Intersect(Rg, Target) Is Nothing Then
For Each c In Rg
Select Case c.Value
Case Is = "NR", "nr"
c.Interior.Color = RGB(255, 0, 0)
Case Is = "CP", "cp"
c.Interior.Color = RGB(255, 165, 0)
Case Is = "Hout", "hout", "HOUT"
c.Interior.Color = RGB(0, 0, 255)
Case Is = "Hin", "hin", "HIN"
c.Interior.Color = RGB(0, 0, 255)
Case Is = "CC", "cc"
c.Interior.Color = RGB(173, 255, 47)
Case Is = "CR", "cr"
c.Interior.Color = RGB(255, 255, 0)
Case Is = "PS", "ps"
c.Interior.Color = RGB(255, 0, 255)
Case Is = "1"
c.Interior.Color = RGB(255, 255, 255)
Case Else
c.Interior.Color = xlAutomatic
End Select
Next
End If
End Sub

**wilfried_42** · 05/08/2009, 16h40

re:

essaye cela, j'ai optimisé un peu (elle prend du temps à chaque saisie)

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
21
22
23
24
25
26
Private Sub Worksheet_Change(ByVal Target As Range)
       Dim Rg As Range
       if not intersect(target,range("F2:F139") is nothing then
              Select Case target.Value
                   Case Is = "NR", "nr"
                         target.Interior.Color = RGB(255, 0, 0)
                   Case Is = "CP", "cp"
                         target.Interior.Color = RGB(255, 165, 0)
                   Case Is = "Hout", "hout", "HOUT"
                         target.Interior.Color = RGB(0, 0, 255)
                   Case Is = "Hin", "hin", "HIN"
                         target.Interior.Color = RGB(0, 0, 255)
                   Case Is = "CC", "cc"
                         target.Interior.Color = RGB(173, 255, 47)
                   Case Is = "CR", "cr"
                         target.Interior.Color = RGB(255, 255, 0)
                   Case Is = "PS", "ps"
                         target .Interior.Color = RGB(255, 0, 255)
                   Case Is = "1"
                         target.Interior.Color = RGB(255, 255, 255)
                   Case Else
                         target.Interior.Color = xlAutomatic
              End Select
              sheets("Nomdemafeuille").range(target.address).interior.color = target.interior.color
       End If
End Sub

en rouge, mettre le nom de la feuille

code fait à main levée, non testé

**annad** · 07/08/2009, 08h10

Merci, je vais essayer lundi au boulot.

**annad** · 10/08/2009, 17h04

Bonjour,
Je viens d'essayer, et il y a une ligne qui se met en rouge.
Comment faire pour mettre le fichier sur le forum?

Merci

**annad** · 11/08/2009, 08h18

Code :

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

if not intersect(target,range("F2:F139") is nothing then

Celle-ci...

**Fvandermeulen** · 11/08/2009, 09h20

Bonjour,
Je me suis permis de reprendre le code de Wilfried_42 dans lequel il y avait deux petites erreurs (désolé) il manquait la parenthèse de fin dans la ligne de 'Intersect' et il y a un espace gênant dans la ligne du 'Case Is PS'

Pour l'exemple j'ai ajouté le principe du Ucase pour éviter de devoir écrire toutes les possibilités de saisies dans les Case Is et j'ai réutilisé la variable Rg de la question initiale.

A+

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
21
22
23
24
25
26
27
28
Private Sub Worksheet_Change(ByVal Target As Range)
Dim Rg As Range
 
    Set Rg = Range("F2:F139")
    If Not Intersect(Rg, Target) Is Nothing Then
              Select Case UCase(Target.Value) 'Considère le mot saisi en majuscule
                   Case Is = "NR" 'Il n'est plus nécessaire d'écrire toute les possibiltés puisque le mot saisi est considéré en majuscule
                         Target.Interior.Color = RGB(255, 0, 0)
                   Case Is = "CP"
                         Target.Interior.Color = RGB(255, 165, 0)
                   Case Is = "HOUT"
                         Target.Interior.Color = RGB(0, 0, 255)
                   Case Is = "HIN"
                         Target.Interior.Color = RGB(0, 0, 255)
                   Case Is = "CC"
                         Target.Interior.Color = RGB(173, 255, 47)
                   Case Is = "CR"
                         Target.Interior.Color = RGB(255, 255, 0)
                   Case Is = "PS"
                         Target.Interior.Color = RGB(255, 0, 255)
                   Case Is = "1"
                         Target.Interior.Color = RGB(255, 255, 255)
                   Case Else
                         Target.Interior.Color = xlAutomatic
              End Select
              Sheets("Nomdemafeuille").Range(Target.Address).Interior.Color = Target.Interior.Color
       End If
End Sub

**annad** · 11/08/2009, 10h40

J'essaye ça cet après midi au boulot.

Encore merci.

**taxi.louis** · 12/08/2009, 01h29

http://www.cijoint.fr/index.php

pour déposer des fichiers sur le site vas voir a cette adresse c gratuit et ca foctionne trés bien

http://www.cijoint.fr/cjlink.php?fil...cij5JKNW7b.xls

**annad** · 12/08/2009, 08h31

Voici le fichier en question:

http://www.cijoint.fr/cjlink.php?fil...cijR2pxykS.xls

Donc, lorsque je mets par exemple "CP" dans la colonne statut de la feuille d'appel, cette cellule doit se mettre en orange, ce qui est le cas mais en même temps, sur la feuille données patient, ça doit se faire automatiquement également. Et l'idéal serait que la cellule juste avant s'y mette aussi mais bon ...
Un casse tête pour moi, un jeu pour d'autre.
Merci d'avance, Dan.

**annad** · 12/08/2009, 08h33

Et un grand merci à taxi louis.

**Fvandermeulen** · 12/08/2009, 08h38

Bonjour Annad,
J'imagine que si tu mets ton fichier c'est que les solutions proposées ne fonctionnent pas, peux tu dire ce qui te bloque ?
A+

Edit: je dois être mal réveillé, j'avais pas vu ton commentaire

**annad** · 12/08/2009, 08h41

bonjour,

Et bien sur la feuille appel pco, les couleurs ne se mettent pas automatiquement au départ d'un changement sur la feuille "Données patient".
Car la feuille "appel pco" est totalement verrouillée pour l'utilisation par mes collègues et tout se gère via la feuille "données patient"

Voilà, merci, Dan.

**Fvandermeulen** · 12/08/2009, 09h00

Salut,
Le problème ne vient pas de là, dans ton code tu fais référence à la feuille "Données patient" alors que ce doit être "Appel PCO":

Code :

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

1
2
3
...
Sheets("Appel PCO").Range(Target.Address).Interior.Color = Target.Interior.Color
...

Mais il reste un autre problème, la cellule correspondante à la cellule F2 de la feuille données est la cellule C7 dans la feuille "Appel PCO"

Essaies et dis quoi

A+

PS si tu veux les mots de passes je les ai trouvés.

**annad** · 12/08/2009, 09h56

En fait il faut que ça change sur les deux feuilles en même temps, l'encodage se fait sur "données patient" et "appel pco" est verrouillé.
Je ne comprend plus rien...je vais devenir fou!!

Et maintenant plus rien ne change de couleur nulle part.... la galère!!

**Fvandermeulen** · 12/08/2009, 10h09

On récapitule...
Tu es sur ta feuille "Données patients" et tu fais une modif donc ça lance la macro qui est sur le module de cette feuille.
MAIS dans ton code, tu réutilise le nom "Données patients" après ton test sur la valeur encodée, tu ne fait jamais mention de la feuille "Appel PCO"
C'est de là que vient le problème, la protection n'a rien à voir.

Essaie ceci:

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
21
22
23
24
25
26
27
28
Private Sub Worksheet_Change(ByVal Target As Range)
Dim Rg As Range
 
    Set Rg = Range("F2:F139")
    If Not Intersect(Rg, Target) Is Nothing Then
              Select Case UCase(Target.Value) 'Considère le mot saisi en majuscule
                   Case Is = "NR" 'Il n'est plus nécessaire d'écrire toute les possibiltés puisque le mot saisi est considéré en majuscule
                         Target.Interior.Color = RGB(255, 0, 0)
                   Case Is = "CP"
                         Target.Interior.Color = RGB(255, 165, 0)
                   Case Is = "HOUT"
                         Target.Interior.Color = RGB(0, 0, 255)
                   Case Is = "HIN"
                         Target.Interior.Color = RGB(0, 0, 255)
                   Case Is = "CC"
                         Target.Interior.Color = RGB(173, 255, 47)
                   Case Is = "CR"
                         Target.Interior.Color = RGB(255, 255, 0)
                   Case Is = "PS"
                         Target.Interior.Color = RGB(255, 0, 255)
                   Case Is = "1"
                         Target.Interior.Color = RGB(255, 255, 255)
                   Case Else
                         Target.Interior.Color = xlAutomatic
              End Select
              Sheets("Appel PCO").Range(Target.Address).Interior.Color = Target.Interior.Color
       End If
End Sub

Mais comme j'ai déjà dis, sur ta feuille Appel PCOn ce n'est pas la bonne cellule qui sera coloriée puisqu'on réutilise l'adresse de la cellule de la feuille "Données clients" qui ne correspond pas à celle de "Appel PCO".

Je vais regarder ce problème maintenant si tu veux.
A+

**annad** · 12/08/2009, 10h28

J'ai rapporté ce fichier de mon boulot, et je l'ai (évidement) mis sur mon pc. Mais je suis en excel 2007 chez moi.
J'ai enregistré en mode de compatibilité 2003 mais plus rien ne fonctionne, c'est normal?
Je viens d'essayer tout ce que vous me proposez, rien ne va, même plus ce qui fonctionnait au début.

Y'a pas quelqu'un de calé (comme vous tous) qui habite la région de Dinant?

**Fvandermeulen** · 12/08/2009, 10h28

Re,
Essaie ce code, il m'a parru plus simple de fonctionner avec le champ "N° de Cellule" (sauf quand j'ai constaté qu'il y avait des numéros de chambre non numériques mais c'est contourné) pour définir la cellule cible sur la feuille Appel PCO.
J'ai fait quelques tests qui semblent concluant mais je te laisse vérifier à fond.

A+

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
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
Private Sub Worksheet_Change(ByVal Target As Range)
Dim Rg As Range
Dim CellC As Integer, CellR As Integer, Tr As Integer
 
    Set Rg = Range("F2:F139")
    If Not Intersect(Rg, Target) Is Nothing Then
              Select Case UCase(Target.Value) 'Considère le mot saisi en majuscule
                   Case Is = "NR" 'Il n'est plus nécessaire d'écrire toute les possibiltés puisque le mot saisi est considéré en majuscule
                         Target.Interior.Color = RGB(255, 0, 0)
                   Case Is = "CP"
                         Target.Interior.Color = RGB(255, 165, 0)
                   Case Is = "HOUT"
                         Target.Interior.Color = RGB(0, 0, 255)
                   Case Is = "HIN"
                         Target.Interior.Color = RGB(0, 0, 255)
                   Case Is = "CC"
                         Target.Interior.Color = RGB(173, 255, 47)
                   Case Is = "CR"
                         Target.Interior.Color = RGB(255, 255, 0)
                   Case Is = "PS"
                         Target.Interior.Color = RGB(255, 0, 255)
                   Case Is = "1"
                         Target.Interior.Color = RGB(255, 255, 255)
                   Case Else
                         Target.Interior.Color = xlAutomatic
              End Select
 
'Def Cellule cible feuille Appel PC
Tr = Target.Row
 
    'Vérifie si le changement impacte un type de chambre
    If Not IsNumeric(Cells(Tr, 2)) And Cells(Tr, 2) <> "CA" Then
        CellC = 15
        CellR = Tr - 87
    Else:
        CellC = Right(Left(Cells(Tr, 1), 3), 1) * 3 'On utilise le numéro du NP de la colonne A pour définir la colonne cible
        If Cells(Tr, 2) = "CA" Then
            CellR = 29 'si la cellule de la colonne 2 est CA alors c'est d'office la ligne 29 sur la feuille cible
        Else:
            CellR = Cells(Tr, 2).Value + 6 'si c'est pas CA, c'est le numéro+6 qui correspond à la ligne sur la feuille cible
        End If
    End If
            Sheets("Appel PCO").Cells(CellR, CellC).Interior.Color = Target.Interior.Color
    End If
End Sub

**annad** · 12/08/2009, 11h49

ça a l'air de fonctionner au poil, juste une toute petite chose, si je peux encore abuser; que la cellule juste devant se colore aussi sur la feuille "appel PCO".
Mais si ce n'est pas possible, aucun problème, ce que vous avez fait est déjà génial.

copier une couleur automatiquement [XL-2003]

Excel

Discussions similaires

Partager

Partager