Discussion :

[facteur]

Bonjour,

Pour les besoins de mon travail, j'ai recupèré une macro qui permet d'imprimer des affiches à partir de données contenu dans un tableau.
J'aimerais inseré dans cette macro un petit programme qui me permettrait d'imprimer en couleur une cellule en fonction de la couleur d'une autre cellule.

je m 'explique :

J'ai une feuille Excel qui contient 2 onglets intitulés " TPGD-TG2" et "TG1der".
1) L'onglet "TG1der" contient un tableau de plusieurs colonnes dont 2 sont importantes pour mon problème ..
La colonne A contient des numero de sortie ( 1 à 478) .
La colonne B recense les destinations dont certaines sont coloriés de certaines couleur ( bleu, rouge, vert..etc).
Je précise qu'à chaque numéro de sortie, correspond une destination unique :
exemple :
A1 =001 B1 =lyon
A2 =002 B2= grenoble
etc..

2) L'onglet "TPGD-TG2" contient les affiches à imprimer.
Chaque affiche est un résumé des données contenues dans le tableau de l'onglet "TPGD-TG2".

Chaque affiche contient entre autre le numéro de sortie et la destination:
je précise que d'une affiche à l'autre , la ligne qui contient le numéro de sortie et la ligne qui contient la destination changent.
Par contre, les colonnes restent les mêmes.
le numéro de sortie se trouve dans la fusion des cellule E et F
la destination se trouve dans la fusion des cellule A à M

j'espere avoir été clair..
merci d'avance

[evx136]

Bonjour

Avec un fichier En pièce jointe et le début de ton code, pour une aide maximale

Cordialement

[Daniel.C]

Bonjour,

Ajoute, au début de la macro :

Code :

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

1
2
3
4
5
6
7
8
9
10
11
12
    Dim C As Range, Plage As Range, X As Range
    With Sheets("TG1der")
        Set Plage = .Range(.[B1], .Cells(.Rows.Count, 2).End(xlUp))
    End With
    With Sheets("TPGD-TG2")
        For Each C In Plage
            Set X = .[A:M].Find(C.Value, , , xlWhole)
            If Not X Is Nothing Then
                X.Interior.ColorIndex = C.Interior.ColorIndex
            End If
        Next C
    End With

[facteur]

Bonjour daniel,
J'ai fais un test et ta macro pose problème :

Sur l'onglet "TG1der", j'ai colorié, avec deux couleurs differentes, deux cellules de la colonne destination ( B2 = Moissy et B3 =Gennevilliers).
Lorsque j'execute pas à pas le programme, au niveau de l'onglet " TPGD-TG2 la ligne qui contient Moissy ( cellule fusionne de A à M) se colore bien de la même couleur que la celulle B2 de l'onglet "TG1". Et même chose avec la ligne qui contient Gennevilliers.
Mais lorsque la boucle

Code :

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

1
2
3
4
5
6
7
8
With Sheets("TPGD-TG2")
        For Each C In Plage
            Set X = .[A:M].Find(C.Value, , , xlWhole)
            If Not X Is Nothing Then
                X.Interior.ColorIndex = C.Interior.ColorIndex
            End If
        Next C
    End With

se poursuit, les couleurs de ces 2 destinations disparaissent.

Que se passe t il ?..
Et pourrais tu également decrire chaque ligne de ton programme

[facteur]

Bonjour evx136,
je te joins le fichier allégé.
par contre, sur la macro, il n ' a aps de debut de code car je ne sais pas comment la commencer..

[facteur]

bonjour Daniel,
je t'envoie le fichier allégé avec ta macro integré pour que tu aies une petite idée de ce que je recherche..

[facteur]

Daniel.C
erreur de jugement, j 'ai refais un test sur un nombre plus grand de destination. Et ton programme fonctionne..
maintenant , je vais le tester sur une copie de mon fichier.
Et je te tiens au courant des anomalies si il y en a..

[evx136]

Le code de Daniel correspond à ta recherche.

Cordialement

[facteur]

Bonjour messieurs daniel.C et evx136

le code de daniel correspond à ma recherche mais pourriez vous me decrire chaque ligne du code pour que je puisse comprendre en cas où je devrais etre amené à modifier ce programme..

[Daniel.C]

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
Sub test()
    Dim C As Range, Plage As Range, X As Range
    ' tout ce qui commence par un point se réfère à la feuille "TG1der"
    With Sheets("TG1der")
        'définition de la plage de la colonne B occupée par des cellules non vides...
        'depuis B1 jusqu'à la dernière cellule non vide
        Set Plage = .Range(.[B1], .Cells(.Rows.Count, 2).End(xlUp))
    End With
    ' tout ce qui commence par un point se réfère à la feuille "TPGD-TG2"
    With Sheets("TPGD-TG2")
        'On boucle sur chaque cellule de la plage définie plus haut (les destinations)
        For Each C In Plage
            'Recherche de la cellule ayant la même valeur dans les colonnes A:M
            Set X = .[A:M].Find(C.Value, , , xlWhole)
            'si on trouve une égalité
            If Not X Is Nothing Then
                'on applique la couleur de fond de la plage source
                X.Interior.ColorIndex = C.Interior.ColorIndex
            End If
        'et on passe à la cellule suivante.
        Next C
    End With
End Sub

[facteur]

merci daniel,

je vais un test sur le fichier joint.
je ne comprend ppas pourquoi, le programme ne fonctionne pas sur la destination "55 BAR LE DUC" de la sortie 009 (onglet "TPGD-TG2"). La couleur ne veut pas s'afficher alors que tout fonctionne pour les autres destinations.

Pour tes explications, lorsque tu dis "

Code :

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

1
2
3
For Each C In Plage
            'Recherche de la cellule ayant la même valeur dans les colonnes A:M
            Set X = .[A:M].Find(C.Value, , , xlWhole)...

tu compares quelle valeur et entre quoi et quoi ?
Est ce la valeur contenue dans la colonne A:M de l'onglet "TPGD-TG2" et la valeur contenu dans la colonne B de l'onglet "TG1der" .

avec le fichier joint daniel..
ta macro s'apelle "couleur"

[Daniel.C]

tu compares quelle valeur et entre quoi et quoi ?
Est ce la valeur contenue dans la colonne A:M de l'onglet "TPGD-TG2" et la valeur contenu dans la colonne B de l'onglet "TG1der" .

Oui.

Pour "55 BAR LE DUC ", tu vois qu'il y a un espace après le "C" final. Il doit y avoir une stricte égalité, sinon, ça ne fonctionne pas.

[facteur]

daniel,
Sur l'onglet " TG1der", je copie le contenu de la cellule B8 ( qui contient le nom BAR LE DUC et dont la macro fonctionne sur cette cellule) et je la colle sur la cellule B10.C'est cette cellule qui présente un soucis.
Normalement je ne devrais pas avoir de problème.
Eh ben si, , sur l'onglet "TPGD-TG2", la cellule A:M qui correspond à la sortie 007 BAR LE DUC se colore bien .
Mais la cellule A:M qui correspond à la sortie 009 BAR LE DUC ne se colore pas.
et c'est bien le même nom

[Daniel.C]

J'avais mal regardé ton classeur :

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, Ligne As Long, Sh As Worksheet
 
    Set Sh = Sheets("TG1der")
    ' tout ce qui commence par un point se réfère à la feuille "TPGD-TG2"
    With Sheets("TPGD-TG2")
        'On boucle sur chaque cellule de la plage définie plus haut (les destinations)
        For Each C In Range(.[B1], .Cells(.Rows.Count, 2).End(xlUp))
            'Recherche de la cellule ayant la même valeur dans les colonnes A:M
            If C.Value = "Sortie" Then
                Ligne = Application.Match(Format(C.Offset(, 3).Value, "000"), Sh.[A:A], 0)
                .Cells(C.Row + 2, 1).Interior.ColorIndex = Sh.[B1].Offset(Ligne - 1).Interior.ColorIndex
            End If
        'et on passe à la cellule suivante.
        Next C
    End With
 
End Sub

[facteur]

Tout fonctionne à merveille daniel
encore merci

Encore une question et j'arrete de t'embeter..
pourrais tu me décrire la ligne ci dessous

Code :

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

1
2
3
4
If C.Value = "Sortie" Then
                Ligne = Application.Match(Format(C.Offset(, 3).Value, "000"), Sh.[A:A], 0)
                .Cells(C.Row + 2, 1).Interior.ColorIndex = Sh.[B1].Offset(Ligne - 1).Interior.ColorIndex
            End If

'et on passe à la cellule suivante.

[Daniel.C]

Je ne sais pas si c'est très clair. N'hésite pas à poser des questions.

Code :

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

1
2
3
4
5
6
7
8
9
'si je trouve "Sortie" dans la colonne B de la feuille "TPGD-TG2"
If C.Value = "Sortie" Then
    'Je recherche la ligne de la valeur correspondante dans la colonne A de la feuille "TG1der"
    ' en formatant la cellule au format texte avec des zéros à gauche (c'est l'équivalent de la
    ' fonction EQUIV
    Ligne = Application.Match(Format(C.Offset(, 3).Value, "000"), Sh.[A:A], 0)
    'Je récupère la couleur de ca cellule correspondante et je l'affecte 2 cellules plus bas en colonne A
    .Cells(C.Row + 2, 1).Interior.ColorIndex = Sh.[B1].Offset(Ligne - 1).Interior.ColorIndex
End If

[facteur]

Bonjour Daniel,
merci pour ces explications qui sont trés clair.
Cela me permettra , si le cas se présente de reprendre cette macro est de la réajuster pour d'autres application.

Encore une petite question..
Dans l'onglet "TPGD-TG2" , dans la cellule qui contient la destination, j'aimerais mettre, par défaut, la couleur de la police en noir.
je pourrais, bien sur, selectionner toutes les cellules et mettre cette police en noir. Mais, si un jour, un collegue souhaite changer la couleur de la police, celle-ci restera dans la couleur choisie par le collègue. Ce que je veux éviter.

[Daniel.C]

Bonjour,

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
Sub couleur()
 
 
    Dim C As Range, Ligne As Long, Sh As Worksheet
 
    Set Sh = Sheets("TG1der")
    ' tout ce qui commence par un point se réfère à la feuille "TPGD-TG2"
    With Sheets("TPGD-TG2")
        'On boucle sur chaque cellule de la plage définie plus haut (les destinations)
        For Each C In Range(.[B1], .Cells(.Rows.Count, 2).End(xlUp))
            'Recherche de la cellule ayant la même valeur dans les colonnes A:M
            If C.Value = "Sortie" Then
                Ligne = Application.Match(Format(C.Offset(, 3).Value, "000"), Sh.[A:A], 0)
                .Cells(C.Row + 2, 1).Interior.ColorIndex = Sh.[B1].Offset(Ligne - 1).Interior.ColorIndex
                .Cells(C.Row + 2, 1).Font.ColorIndex = xlAutomatic
            End If
        'et on passe à la cellule suivante.
        Next C
    End With
 
End Sub

[facteur]

perfect
merci Daniel

[facteur]

Bonjour Daniel,

c'est encore moi..désole de t'embeter mais il ne fallait pas etre pro en vba excel...
Cette fois , c'est encore une question de coloriage mais vu différemment.

J'ai un tableau qui va de la cellule A13 à Q43.
La colonne A contient des dates .
En A1 , j'incris le 1er jour du mois sous la forme 01/10/2012 puis je mets cette date avec le format personnalisé jjjj jj mmm ( ce qui me donne le format lundi 01 oct)
Ensuite, A2= A1+1; A3=A2+1 et ainsi de suite jusqu'à la journée du 30 ou 31 ( en fonction des mois).

Je souhaiterais colorier les lignes de ce tableau en fonction des journées:
si La colonne A contient "mercredi" alors les lignes du tableau contenant "mercredi" se colore en gris.
si la colonne A contient "samedi" ou "dimanche" alors les lignes du tableau se colorent en rouge.


J'ai essayé de commencé le module mais en vain
Voici mon ébauche...

Code :

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

1
2
3
4
5
6
7
8
9
10
11
12
13
14
Sub ligne_couleur()
 
Dim rcel As Range
Range("A13").Select
 Selection.CurrentRegion.Select
 
 For Each rcel In Selection
 If rcel.Value = "mercredi" Then
    col.Interior.ColorIndex = 48
 End If
 Next rcel
 
 
End Sub