Discussion :

[niafron71]

Bonjour,

J'aurais aimé savoir s'il était possible qu'une macro "s'actualise" dès que le contenu d'une cellule est modifiée car je dois la relancer à la main à chaque fois que je change le contenu d'une cellule.

Merci d'avance pour vos piste!

[gFZT82]

Bonjour,

Regarde l’évènement Worksheet.Change qui provoquera le lancement de ta procédure lorsque les cellules de la feuille seront modifiées.

Cordialement.

[niafron71]

Je ne connais pas du tout cette fonction et je ne sais pas comment l'insérer dans mon code. Faut il la placer dans "ThisWorkbook"?

Voici mon 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
 
Sub Couleur()
 
    Dim WS As Worksheet
    Dim k As Long, i As Long, j As Long
 
    Set WS = ThisWorkbook.Worksheets("Feuil1")
    With WS
        k = .Cells(.Rows.Count, 1).End(xlUp).Row
 
        For i = 2 To k
        If .Cells(i, 15) = "<=" Then
            For j = 1 To 12
 
            If .Cells(i, j) <= .Cells(i, 13) Then
                .Cells(i, j).Interior.Color = RGB(0, 150, 0)
            ElseIf .Cells(i, j) >= .Cells(i, 14) Then
                        .Cells(i, j).Interior.Color = RGB(255, 0, 0)
            Else
                 .Cells(i, j).Interior.Color = RGB(255, 130, 0)
            End If
            Next
        Else
            For j = 1 To 12
 
                If .Cells(i, j) >= .Cells(i, 13) Then
                    .Cells(i, j).Interior.Color = RGB(0, 150, 0)
                ElseIf .Cells(i, j) <= .Cells(i, 14) Then
                        .Cells(i, j).Interior.Color = RGB(255, 0, 0)
                Else
                    .Cells(i, j).Interior.Color = RGB(255, 130, 0)
                End If
            Next
        End If
    Next i
End With
 
End Sub

[gFZT82]

La procédure doit être placée dans le module de la feuille à laquelle elle s’applique (Feuil1).

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
Private Sub Worksheet_Change(ByVal Target As Range)
Dim WS As Worksheet
Dim k As Long, i As Long, j As Long
    If Target.Count = 1 Then
        Set WS = ThisWorkbook.ActiveSheet
        With WS
            k = .Cells(.Rows.Count, 1).End(xlUp).Row
            For i = 2 To k
                If .Cells(i, 15) = "<=" Then
                    For j = 1 To 12
                        If .Cells(i, j) <= .Cells(i, 13) Then
                            .Cells(i, j).Interior.Color = RGB(0, 150, 0)
                        ElseIf .Cells(i, j) >= .Cells(i, 14) Then
                            .Cells(i, j).Interior.Color = RGB(255, 0, 0)
                        Else
                            .Cells(i, j).Interior.Color = RGB(255, 130, 0)
                        End If
                    Next
                Else
                    For j = 1 To 12
                        If .Cells(i, j) >= .Cells(i, 13) Then
                            .Cells(i, j).Interior.Color = RGB(0, 150, 0)
                        ElseIf .Cells(i, j) <= .Cells(i, 14) Then
                            .Cells(i, j).Interior.Color = RGB(255, 0, 0)
                        Else
                            .Cells(i, j).Interior.Color = RGB(255, 130, 0)
                        End If
                    Next
                End If
            Next i
        End With
    End If
End Sub

Cordialement.

[niafron71]

Je te remercie! Cela marche parfaitement, est ce qu'il existe un moyen de le faire pour toute les feuilles? J'aurais besoin de cette macro sur toute les feuilles de mon classeur ( plusieurs dizaines).

[gFZT82]

Tu peux utiliser l'évènement Workbook_SheetChange du module ThisWorkbook

http://silkyroad.developpez.com/VBA/...asseur/#LII-20

Cordialement.

[niafron71]

Merci, cela marche parfaitement!