Automatisation macro et contenu de cellule

Version imprimable

20/06/2012, 14h00
niafron71

Automatisation macro et contenu de cellule

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!
20/06/2012, 14h11
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.

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:

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

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

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
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.

20/06/2012, 15h03
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).
20/06/2012, 15h20
gFZT82

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

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

Cordialement.
20/06/2012, 15h28
niafron71

Merci, cela marche parfaitement!