Gestion de couleur en VBA

Version imprimable

Bonjour

je souhaite faire une macro dans excel qui colore une page en fonction de la valeur (texte) la case.
Structure du document:
-un onglet principal contenant une liste de nom/prénom (par ordre alphabetique) en colonne A et un attribut en colonne B (qui prend 5 valeurs fixes via un menus déroulant)
-le second onglet à pour fontion de ranger les noms dans un autre ordre (représentation graphique)

mon problème:
débutant en VBA je j'ai des problème dans mon code, je souhaite dans mon second onglet à partir de la A3 jusqu'a L20 parcourir toutes les cases identifier le noms present dans la case et colorer (les couleur sont presentes dans les case B121 à B126) la case en fonction de l'attribut lier au noms dans le premier onlet.

Code:

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
Sub test_couleur()
 
    Const NB_LIGNE As Integer = 20 '20 Ligne
    Const NB_COLONNE As Integer = 12 '12 Ligne
    Dim Icol As Byte
 
    For l = 3 To NB_LIGNE 'l => n° ligne
 
 
        For c = 1 To NB_COLONNE 'c => n° colonne
 
 
 
            Icol = 1
            While Worksheets("Répartition des internes").Cells(c, l).Value <> Worksheets("éléve par ordre alphabetique").Cells(2, 1).Value Or i = 112
            'Worksheets("Répartition des internes").Cells(c, l).Value <> Worksheets("éléve par ordre alphabetique").Cells(2, i).Value
            'Cells(c & l).Interior.Color = Sheets("éléve par ordre alphabetique").Cells(2 & 126).Interior.Color
            Icol = Icol + 1
            Wend
            Icol = Icol - 1
            If Sheets("éléve par ordre alphabetique").Cells(3 & i) = "AUTRE" Then
                Cells(c, l).Interior.Color = Sheets("éléve par ordre alphabetique").Range("B125").Interior.Color
            End If
            If Sheets("éléve par ordre alphabetique").Cells(3 & i) = "BROS/BLAN" Then
                Cells(c, l).Interior.Color = Sheets("éléve par ordre alphabetique").Range("B122").Interior.Color
            End If
            If Sheets("éléve par ordre alphabetique").Cells(3 & i) = "A.BRIAND" Then
                Cells(c, l).Interior.Color = Sheets("éléve par ordre alphabetique").Range("B121").Interior.Color
            End If
            If Sheets("éléve par ordre alphabetique").Cells(3 & i) = "HEINLEX" Then
                Cells(c, l).Interior.Color = Sheets("éléve par ordre alphabetique").Range("B123").Interior.Color
            End If
            If Sheets("éléve par ordre alphabetique").Cells(3 & i) = "BOULLOCHE" Then
                Cells(c, l).Interior.Color = Sheets("éléve par ordre alphabetique").Range("B124").Interior.Color
            Else
                Cells(c, l).Interior.Color = Sheets("éléve par ordre alphabetique").Cells(2 & 126).Interior.Color
            End If
        Next c
    Next l
 
End Sub

merci pour votre aide

Hermès

en couleur

J'ai essayé de voir le code, beaucoup de flou... le i non typé , pourquoi?

J'ai fait un essai avec qques noms en prenant vos références de tables, en recherchant par FIND les noms, puis la couleur correspondante en B121:B126 cela fonctionne...

Voilà mon code :

Code:

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
Sub test_couleur()
 
Const NB_LIGNE As Integer = 10 '10 Lignes
Const NB_COLONNE As Integer = 11 '11 colonnes
 
Dim noms As Range, trouve As Range, rangecouleur As Range
Dim adcoul As String
 
 
 
Set noms = Worksheets("éléve par ordre alphabetique").Range("A2:A9")
Set rangecouleur = Worksheets("éléve par ordre alphabetique").Range("B121:B126")
 
 
 
For l = 3 To NB_LIGNE 'l => n° ligne
 
 
For c = 1 To NB_COLONNE 'c => n° colonne
 
Set trouve = noms.Find(Worksheets("Répartition des internes").Cells(l, c))
If trouve Is Nothing Then
           MsgBox ("non trouvé")
                     Else
           Set trouve = rangecouleur.Find(Worksheets("éléve par ordre alphabetique").Cells(trouve.Row, trouve.Column + 1))
           Worksheets("Répartition des internes").Cells(l, c).Interior.Color = trouve.Interior.Color
End If
Next c
Next l
 
End Sub

bonne soirée

geogeo

22/01/2016, 04h11
kiki29

Salut, voir La mise en forme conditionnelle dans Excel

P.-S. : Balise ton code stp
28/01/2016, 23h42
monhermes

super merci

j'ai trouver la solution à mon problème grâce a ton code qui ma bien éclairé...