Discussion :

[Invité]

Bonjour,

je dois crée une macro qui lorsque j'appuie sur le bouton
il applique une couleur de fond et une couleur de texte en fonction du numéro indiqué dans la colonne H

ex:
- les valeurs 0001 , 0002 , 0003 , 1000 et 1001 = applique un fond rouge avec un texte blanc
- les valeurs 0004 , 0007 , 0204 , 1010 et 1011 = applique un fond orange avec un texte blanc
- les valeurs 0006 , 1020 = applique un fond vert avec un texte blanc

Merci de bien vouloir m'aider

Cordialement,

[bboy-eazy]

Bonjour,

vous pouvez faire ceci avec l'enregistreur de macro.
Voir ensuite du coté de colorindex pour les codes couleur

faire une boucle du style

Code :

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

1
2
3
4
5
Set CL = ThisWorkbook.Sheets("feuille")
For i = 1 To 10
If CL.Cells(i, "H").Value = 0001 Or CL.Cells(i, "H").Value = 0002 Then 'etc...
CL.Cells(i, "H").Interior.ColorIndex = 50 'trouver le bon numéro de colorindex pour la couleur
End If

[Invité]

Merci pour votre réponse,

je n'utilise pas la fonction .Interior.ColorIndex mais .Interior.Color = RGB(255, 255, 255) pour me facilité dans les couleurs.
et le code ci-dessous fonctionne pour la couleur de fond mais pas pour la couleur du texte.

Est ce que ce code peux fonctionner?

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
Set CL = ThisWorkbook.Sheets("feuille")
For i = 1 To 10
If CL.Cells(i, "H").Value = 0001 Or CL.Cells(i, "H").Value = 0002 Or CL.Cells(i, "H").Value = 0003 Or CL.Cells(i, "H").Value = 1000 Or CL.Cells(i, "H").Value = 1001
    CL.Cells(i, "H").Font.Color = RGB(255, 255, 255) 'Police Couleur Blanche
    CL.Cells(i, "H").Interior.Color = RGB(255, 0, 0) 'Police Couleur Rouge
End If

If CL.Cells(i, "H").Value = 0004 Or CL.Cells(i, "H").Value = 0007 Or CL.Cells(i, "H").Value = 0204 Or CL.Cells(i, "H").Value = 1010 Or CL.Cells(i, "H").Value = 1011
    CL.Cells(i, "H").Font.Color = RGB(255, 255, 255) 'Police Couleur Blanche
    CL.Cells(i, "H").Interior.Color = RGB(228, 109, 10) 'Police Couleur Orange
End If

If CL.Cells(i, "H").Value = 0006 Or CL.Cells(i, "H").Value = 0120
    CL.Cells(i, "H").Font.Color = RGB(255, 255, 255) 'Police Couleur Blanche
    CL.Cells(i, "H").Interior.Color = RGB(0, 176, 80) 'Police Couleur Vert
End If

Et la deuxième ligne For = 1 To 10 ne me plait pas :/ sachant que c'est une table dynamique il faut aller de H3 jusqu'à la dernière ligne.

j'ai ce code la pour pallier le problème d'ajouter jusqu'à la dernière ligne mais je ne sais pas trop comment je vais l'ajouter :/

Code :

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

1
2
3
4
5
6
7
8
9
 
Dim i As Integer
Dim derl As Long
Dim Targ As Range
 
    derl = Range("A" & Rows.Count).End(xlUp).Row
 
    For i = 3 To derl
        Set Targ = ActiveSheet.Range("N" & i)

[Theze]

Bonjour,

Teste ce qui suit. Je suppose que la colonne H est au format texte :

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
 
Sub Colorer()
 
    Dim Fe As Worksheet
    Dim I As Long
    Dim DL As Long
 
    Set Fe = Sheets("feuille")
 
    DL = Range("A" & Rows.Count).End(xlUp).Row
 
    For I = 1 To DL
 
    With Fe.Range("H" & I)
 
        Select Case .Value
 
            '- les valeurs 0001 , 0002 , 0003 , 1000 et 1001 = applique un fond rouge avec un texte blanc
            Case "0001", "0002", "0003", "1000", "1001"
                .Font.Color = RGB(255, 255, 255) 'Police Couleur Blanche
                .Interior.Color = RGB(255, 0, 0) 'Police Couleur Rouge
 
             '- les valeurs 0004 , 0007 , 0204 , 1010 et 1011 = applique un fond orange avec un texte blanc
             Case "0004", "0007", "0204", "1010", "1011"
                .Font.Color = RGB(255, 255, 255) 'Police Couleur Blanche
                .Interior.Color = RGB(228, 109, 10) 'Police Couleur Orange
 
            '- les valeurs 0006 , 1020 = applique un fond vert avec un texte blanc
            Case "0006", "0120"
                .Font.Color = RGB(255, 255, 255) 'Police Couleur Blanche
                .Interior.Color = RGB(0, 176, 80) 'Police Couleur Vert
 
        End Select
 
    End With
 
    Next I
 
End Sub

Hervé.

[Invité]

Ouiii merci sa marche mais si jamais je veux effacer les couleurs et remettre par défaut, je fais comment?

[Theze]

Bonjour,

De cette façon (je re-poste tout le code) :

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
 
Sub Colorer()
 
    Dim Fe As Worksheet
    Dim I As Long
    Dim DL As Long
 
    Set Fe = Sheets("feuille")
 
    DL = Range("A" & Rows.Count).End(xlUp).Row
 
    'supprime la coloration
    Fe.Range("H1:H" & DL).Interior.ColorIndex = 0
    Fe.Range("H1:H" & DL).Font.ColorIndex = 0
 
    For I = 1 To DL
 
    With Fe.Range("H" & I)
 
        Select Case .Value
 
            '- les valeurs 0001 , 0002 , 0003 , 1000 et 1001 = applique un fond rouge avec un texte blanc
            Case "0001", "0002", "0003", "1000", "1001"
                .Font.Color = RGB(255, 255, 255) 'Police Couleur Blanche
                .Interior.Color = RGB(255, 0, 0) 'Police Couleur Rouge
 
             '- les valeurs 0004 , 0007 , 0204 , 1010 et 1011 = applique un fond orange avec un texte blanc
             Case "0004", "0007", "0204", "1010", "1011"
                .Font.Color = RGB(255, 255, 255) 'Police Couleur Blanche
                .Interior.Color = RGB(228, 109, 10) 'Police Couleur Orange
 
            '- les valeurs 0006 , 1020 = applique un fond vert avec un texte blanc
            Case "0006", "0120"
                .Font.Color = RGB(255, 255, 255) 'Police Couleur Blanche
                .Interior.Color = RGB(0, 176, 80) 'Police Couleur Vert
 
        End Select
 
    End With
 
    Next I
 
End Sub

Hervé.

[casefayere]

bonjour,

essayes

Code :

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

1
2
3
4
With Workbooks(Fic_SRC).Worksheets("Feuil1").Cells(I, 8)
  .Font.Color = Workbooks(Fic_COUL).Worksheets("CODES").Cells(ligc, 10).Font.Color
  .Interior.Color = Workbooks(Fic_COUL).Worksheets("CODES").Cells(ligc, 10).Interior.Color
End With

[Invité]

j'ai une erreur
La méthode Select de la case Range à échouer

Code :

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

1
2
3
4
5
6
7
8
9
10
11
12
        '---- si le code panne est trouvé
        If code_panne_T = code_panne_CC Then
            Workbooks(Fic_SRC).Worksheets("Feuil1").Cells(I, 8).Select
 
 
            With Workbooks(Fic_SRC).Worksheets("Feuil1").Cells(I, 8)
                .Font.Color = Workbooks(Fic_COUL).Worksheets("CODES").Cells(ligc, 10).Font.Color
                .Interior.Color = Workbooks(Fic_COUL).Worksheets("CODES").Cells(ligc, 10).Interior.Color
            End With
 
            trouve = 1
        End If

[casefayere]

La méthode Select de la case Range à échouer

C'est un autre problème, à toi de vérifier la variable "I"
d'ailleurs à quoi sert cette ligne ? pourquoi selectionner ?

[Invité]

Le processus qui se passe, le fichier va attribuer la couleur qui se trouve dans un autre fichier en fonction de la valeur qui lui es attribué.

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
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
Dossier_RAC = "F:\base\"
 
Fic_COUL = "code couleur.xls"
Fic_SRC = ActiveWorkbook.Name
 
 
chem_fic = Dossier_RAC & Fic_COUL
If Not Isopen(Fic_COUL) Then
    ouvre_fichier (chem_fic)
End If
 
chem_fic = Dossier_RAC & Fic_SRC
If Not Isopen(Fic_SRC) Then
    ouvre_fichier (chem_fic)
End If
 
'on se positionne en A3 car la ligne 1 contient un titre et la ligne 2 l'entêtes
Set lig1_courant = Workbooks(Fic_SRC).Worksheets("Feuil1").Range("A3")
 
lig = 0
nb = 0
 
' début du fichier : les lignes 1 et 2 sont des entêtes
' le traitement commencera à la ligne 3 avec i=i+1
I = 2
 
Do While Not IsEmpty(lig1_courant)
    I = I + 1
    ' récupération du code panne
    code_panne_T = Workbooks(Fic_SRC).Worksheets("Feuil1").Cells(I, 8).Text
 
 
'
'///    -------------------------------------------------
'///    recherche code panne dans fichier des couleurs
'///    -------------------------------------------------
'
'          balayage de la feuille nommée "CODES", la tableau commence en A3
'
    ligc = 1
    trouve = 0
 
    Set lig2_courant = Workbooks(Fic_COUL).Worksheets("CODES").Range("A3")
 
    Do While Not IsEmpty(lig2_courant)
        ligc = ligc + 1
 
        niveau = Workbooks(Fic_COUL).Worksheets("CODES").Cells(ligc, 10).Text
 
'       code panne de la colonne 1 dans le fichier des couleurs
        code_panne_CC = Workbooks(Fic_COUL).Worksheets("CODES").Cells(ligc, 1).Text
 
 
        '---- si le code panne est trouvé
        If code_panne_T = code_panne_CC Then
            Workbooks(Fic_SRC).Worksheets("Feuil1").Cells(I, 8).Select
 
 
            With Workbooks(Fic_SRC).Worksheets("Feuil1").Cells(I, 8)
                .Font.Color = Workbooks(Fic_COUL).Worksheets("CODES").Cells(ligc, 10).Font.Color
                .Interior.Color = Workbooks(Fic_COUL).Worksheets("CODES").Cells(ligc, 10).Interior.Color
            End With
 
            trouve = 1
        End If
 
'       si code panne trouvé, on sort de la boucle
        If trouve = 1 Then
            Exit Do
        End If
 
        Set lig2_suivant = lig2_courant.Offset(1, 0)
        Set lig2_courant = lig2_suivant
 
    Loop
 
'   passage à la ligne suivante fichier src
    Set lig1_suivant = lig1_courant.Offset(1, 0)
    Set lig1_courant = lig1_suivant
 
Loop

[casefayere]

De toute façon je pense que cette ligne ne sert à rien

Code :

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

Workbooks(Fic_SRC).Worksheets("Feuil1").Cells(I, 8).Select

[Invité]

ouiii merci sa marche !!