adapter vb pour codes couleur

**vandewinkel** · 31/01/2010, 12h12

Salut ts le monde,

On m'a donné un coup de main pour faire ce bout de code "merci à Frédéric"
J'ai encore deux modif que je n'arrive pas à faire?
1) quand je modifie le code couleur en "F5, H5..." les couleur dans la colonne "U" ne s'adapte pas, je dois valider chaque celulle avec un "enter"

2) j'ai voulu en plus de la colonne "U" les celulles en "F3, H3 ..." pour avoir une muilleur vision du choix.

Si vous pouviez jeter un coup d'oeil ce sezrait sympa.
Merci

**jfontaine** · 31/01/2010, 13h55

Bonjour,

J'ai un peu adapté ton 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
44
45
46
47
48
49
Private Sub Worksheet_Change(ByVal Target As Range)
 
Dim i As Integer
Dim R As Range
 
Select Case Target.Column
    Case 21
        If Target.Row >= 10 And Target.Row <= 39 Then Couleur Target
    Case 6, 8, 10, 12, 14, 16, 18
        If Target.Row = 5 Then
 
            For i = 10 To 39
                Set R = Range("U" & i)
                Couleur R
            Next i
 
        End If
 
End Select
 
 
 
End Sub
 
 
Private Sub Couleur(Target As Range)
 
With Target
    Select Case Target.Value
        Case Is = Sheets("Param").Range("F5")
            .Interior.ColorIndex = Sheets("Param").Range("F5")
        Case Is = Sheets("Param").Range("H5")
            .Interior.ColorIndex = Sheets("Param").Range("H5")
        Case Is = Sheets("Param").Range("J5")
            .Interior.ColorIndex = Sheets("Param").Range("J5")
        Case Is = Sheets("Param").Range("L5")
            .Interior.ColorIndex = Sheets("Param").Range("L5")
        Case Is = Sheets("Param").Range("N5")
            .Interior.ColorIndex = Sheets("Param").Range("N5")
        Case Is = Sheets("Param").Range("P5")
            .Interior.ColorIndex = Sheets("Param").Range("P5")
        Case Is = Sheets("Param").Range("R5")
            .Interior.ColorIndex = Sheets("Param").Range("R5")
        Case Else
        .Interior.ColorIndex = xlNone
    End Select
End With
 
End Sub

Est ce que c'est ok

**vandewinkel** · 31/01/2010, 14h15

Merci Jérôme,

C'est presque bon, les couleurs de la ligne 3 ne bougent pas?

Envoyé par jfontaine

Bonjour,

J'ai un peu adapté ton 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
44
45
46
47
48
49
Private Sub Worksheet_Change(ByVal Target As Range)
 
Dim i As Integer
Dim R As Range
 
Select Case Target.Column
    Case 21
        If Target.Row >= 10 And Target.Row <= 39 Then Couleur Target
    Case 6, 8, 10, 12, 14, 16, 18
        If Target.Row = 5 Then
 
            For i = 10 To 39
                Set R = Range("U" & i)
                Couleur R
            Next i
 
        End If
 
End Select
 
 
 
End Sub
 
 
Private Sub Couleur(Target As Range)
 
With Target
    Select Case Target.Value
        Case Is = Sheets("Param").Range("F5")
            .Interior.ColorIndex = Sheets("Param").Range("F5")
        Case Is = Sheets("Param").Range("H5")
            .Interior.ColorIndex = Sheets("Param").Range("H5")
        Case Is = Sheets("Param").Range("J5")
            .Interior.ColorIndex = Sheets("Param").Range("J5")
        Case Is = Sheets("Param").Range("L5")
            .Interior.ColorIndex = Sheets("Param").Range("L5")
        Case Is = Sheets("Param").Range("N5")
            .Interior.ColorIndex = Sheets("Param").Range("N5")
        Case Is = Sheets("Param").Range("P5")
            .Interior.ColorIndex = Sheets("Param").Range("P5")
        Case Is = Sheets("Param").Range("R5")
            .Interior.ColorIndex = Sheets("Param").Range("R5")
        Case Else
        .Interior.ColorIndex = xlNone
    End Select
End With
 
End Sub

Est ce que c'est ok

**jfontaine** · 31/01/2010, 14h47

Ajoute la ligne en rouge

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
Select Case Target.Column
    Case 21
        If Target.Row >= 10 And Target.Row <= 39 Then Couleur Target
    Case 6, 8, 10, 12, 14, 16, 18
        If Target.Row = 5 Then
                                           
            Cells(3, Target.Column).Interior.ColorIndex = Target.Value
                                           
            For i = 10 To 39
                Set R = Range("U" & i)
                Couleur R
            Next i
            
        End If
        
End Select

**vandewinkel** · 31/01/2010, 15h30

Merci beaucoup, c'est tip top
bon reste de we

Envoyé par jfontaine

Ajoute la ligne en rouge

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
Select Case Target.Column
    Case 21
        If Target.Row >= 10 And Target.Row <= 39 Then Couleur Target
    Case 6, 8, 10, 12, 14, 16, 18
        If Target.Row = 5 Then
                                           
            Cells(3, Target.Column).Interior.ColorIndex = Target.Value
                                           
            For i = 10 To 39
                Set R = Range("U" & i)
                Couleur R
            Next i
            
        End If
        
End Select

adapter vb pour codes couleur

Excel

Discussions similaires

Partager

Partager