Discussion :

[Le_syd1961]

Bonjour a tous ...
Je patauge un peu dans la semoule binaire ... enfin on est loin du binaire mais c'est histoire de dire !...

Je vous joins un petit fichier exemple que j'adapterai à mon fichier bien plus lourd et complexe et qui jusque là n'avait pas besoin de VBA pour tourner ... sauf qu'à le peaufiner pour le rendre plus ... autonome, je me retrouve confronté à des problèmes qui dépassent ma pauvre compréhension du VBA. Bref j'explique ...


Données de base :

J'ai une feuille Excel contenant 3 tableaux que j'appellerai A ("A2:D9"), B ("I10:L13") et C ("A14:C25")
Une colonne d'une 20aine de donnée ("G20:G24") servant de base de liste de choix pour des cellules "pick list" situées dans les tableaux A en ("A2:A9") et B en ("J10:J13")
Ces cellules de la colonne pick list sont toutes dotées d'un code couleur différent.

Les tableaux A et B sont essentiellement des tableaux d'entrée de donnée
Le C est un récapitulatif de format différent des valeurs entrées dans le tableau B.

But recherché par la macro :

Sur un changement de valeur dans les cellules picklist des tableaux A et B, je voudrais que les cellules en lien des tableaux B et C prennent la couleur référence de la cellule pick list...

Ce que j'ai fait jusqu'à présent (pas tout seul !) :
Appeler la macro sur un changement de la feuille
Déterminer si les cellules picklist ont été modifiées
Changer la couleur de la ligne du tableau A en fonction de l'item choisi dans les cellules pick list de ce même tableau

Ce que j'aimerai pouvoir faire :
Modifier la couleur des "carrés de secteur" du tableau C en fonction du "Type" choisi dans les pick lists du tableau B

je poste le fichier ...
Vous pouvez constater que le tableau C est formé de 4 carrés nommés secteur 1 a 4
Les deux carrés supérieurs sont correctement (et manuellement) de la couleur idoine au "type" sélectionné dans le tableau B et en regard de mon code couleur ...
Les deux carrés inférieurs par contre n'ont pas été colorisés manuellement et présentent une bicoloration.

[ARTURO83]

Bonjour,

Remplacez le code existant par celui-ci

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
Option Explicit
 
Private Sub Worksheet_Change(ByVal Target As Range)
    Dim x As Integer, i As Integer, j As Integer
    Application.EnableEvents = False
    If Target.Count > 1 Then Exit Sub
    x = Application.Match(Target, Range("G1:G24"), 0)
    If Not Intersect(Target, Range("A2:A9")) Is Nothing Then
        Range("A" & Target.Row & ":" & "D" & Target.Row).Interior.Color = Range("G" & x).Interior.Color
    ElseIf Not Intersect(Target, Range("J10:J13")) Is Nothing Then
        For i = 15 To 21 Step 6
            For j = 1 To 3 Step 2
                If Right(Cells(i + 1, j), 1) = Target Then
                    Range(Cells(i, j), Cells(i + 4, j + 1)).Interior.Color = Range("G" & x).Interior.Color
                End If
            Next j
        Next i
    End If
    Application.EnableEvents = True
End Sub

Cdlt

[Le_syd1961]

Bonjour Arturo et merci pour la solution proposée, c'est efficace avec ce fichier exemple mais difficilement adaptable sur mon fichier final qui est plus ... complexe.
J'ai tenté une autre approche et suis parvenu à quelque chose sur mon fichier exemple (ici joint) qui se trouve ne pas marcher sur le fichier final de travail que je joints egalement.

Evidement le fichier test de départ est bien plus simple et seulement destiné a elaborer mon code pour le fichier final.
Le code de ce dernier est partiellement complet car je me suis arreté dés que j'ai constaté qu'il ne faisait ce que je lui demandais à savoir coloriser mes cases comme vous avez fort bien reussi ici avec votre boucle subtile mais pas tres adaptable...

Pourriez vous me dire pourquoi ma routine fonctionne sur le premier fichier (Test LeSyd-V3 fonctionnel) pour coloriser les cases que je désire, mais pas sur le fichier final alors qu'il n'y a que des ''case'' suplementaires! ...

merci a vous pour votre aide precieuse.

Yves

[ARTURO83]

Bonjour,

Ne serait-ce pas ceci

Code :

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

If Intersect(Target, Range("E7:E14,J10:J14,U13:U65")) Is Nothing Then Exit Sub

plutôt que cela

Code :

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

If Intersect(Target, Range("E7:E14,J10:J14,T15:T67")) Is Nothing Then Exit Sub

Cdlt

[Le_syd1961]

Je pense qu'il faut que j'y aille au cas par cas ...
Quand dans le fichier "final" je modifie par exemple dans la colonne 21 en regard du "pit 1" mettons le type "PHB"
les cases coté gauche (sur la zone d'impression en passant) prennent la couleur du type PHB

sur le fichier exemple, ca le fait tres bien ... mais pas sur le fichier final ...

essayez le pour voir vous comprendrez peut etre mieux ce uqe je veux dire

merci

[ARTURO83]

Chez moi, ça fonctionne bien, j'ai sélectionné PHB en U13, et le pavé "E19:F23" à bien pris la couleur orange

Je joins le fichier
Pièce jointe 496510