Ecouter un evenement sur une cellule et le reproduire sur une autre cellule

**kulnae** · 13/08/2009, 16h21

Bonjour,

J'ai cherché brievement et je n'ai pas trouvé grand chose de concluant, mes connaissances en vba n'arrangeant rien ...

J'aurais besoin d'écouter sur plusieurs cellules d'une feuille excel un changement de couleur et de répercuter ce changement de couleur sur d'autres cellules se trouvant sur d'autres feuilles.

J'ai trouvé ce code sur votre site mais je ne sais pas comment l'utiliser ...

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
Option Explicit 
 
Dim x As Integer 
Dim Cell As String 
 
 
 
Private Sub Worksheet_Activate() 
        x = ActiveCell.Interior.ColorIndex 
        Cell = ActiveCell.Address 
End Sub 
 
 
 
Private Sub Worksheet_SelectionChange(ByVal Target As Range) 
    On Error Resume Next 
 
    If Cell = "" Then 
        x = Target.Interior.ColorIndex 
        Cell = Target.Address 
        Exit Sub 
    End If 
 
    If Range(Cell).Interior.ColorIndex <> x Then _ 
        MsgBox "la couleur de la cellule " & Cell & " a changé" 
 
    x = Target.Interior.ColorIndex 
    Cell = Target.Address 
End Sub

Merci à vous !
Kulnae.

**diude54** · 13/08/2009, 16h35

Ce code permet de changer la couleur d'une case quand on en modifie une deuxième

Code :

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

1
2
3
4
5
6
7
8
Private Sub Worksheet_change(ByVal target As Range)
 
If target.adress = range("Ta case").adress Then
x=target.interior.colorindex
range("la case à modifier en même temps").interior.colorindex=x
End If
 
end sub

**diude54** · 13/08/2009, 16h43

Pour ecouter plusieurs cellule tu peux faire la même chose

Code :

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

1
2
3
4
5
6
7
8
9
10
11
Private Sub Worksheet_change(ByVal target As Range)
Select Case target.adress
Case range("A1").adress
x=target.interior.colorindex
range("la case à modifier en même temps").interior.colorindex=x
Case range("A2").adress
x=target.interior.colorindex
range("la case à modifier en même temps").interior.colorindex=x
...
End Select
end sub

Si les cases à changer sont toujours placées par exemple 2 case plus loin que la case écoutée tu peux condenser ça sur une ligne.
Si toutes les cases à écouter sont sur une colonne:

Code :

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

1
2
3
4
5
6
Private Sub Worksheet_change(ByVal target As Range)
if target.column=1 'pour ecouter la colonne 1 par exemple
x=target.interior.colorindex
cells(target.rows,target.column+2).interior.colorindex=x
end if
end sub

**kulnae** · 13/08/2009, 22h28

Merci à toi diude !

Mais j'aimerais savoir, comment faire pour une fois cette macro créer, la "faire marcher" ? L'appliquer aux cellules pour qu'elle joue son rôle ?

Merci.

**diude54** · 14/08/2009, 08h50

Tu ouvre l'editeur visual basic et tu place le code dans ta feuille.
Ex Dans feuil1 si c'est sur cette feuille...
Pour ouvrir l'editeur tu va dans outils=> macro=>visual basic editor

**kulnae** · 14/08/2009, 09h56

Bonjour,

Tu ouvre l'editeur visual basic et tu place le code dans ta feuille.
Ex Dans feuil1 si c'est sur cette feuille...

Merci de tes réponses diude mais je n'ai toujours pas compris comment faire ...

Comment je "place" le code dans la feuille ?
Une macro sur un fichier objet image je sais le faire, mais ça non ...

Sinon, voilà mon code largement inspiré de ton code. Qu'en penses-tu ?

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
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
Private Sub Worksheet_change(ByVal target As Range)
 
Select Case target.adress
 
Case Range("B7").adress
x = target.Interior.ColorIndex
If x = 16 Then Range("'FI'!B7").Interior.ColorIndex = x
                ActiveWorkbook.Sheets("MDD1").Tab.ColorIndex = x
End If
 
Case Range("B8").adress
x = target.Interior.ColorIndex
If x = 16 Then Range("'FI'!B8").Interior.ColorIndex = x
                ActiveWorkbook.Sheets("MDD2").Tab.ColorIndex = x
End If
 
Case Range("B9").adress
x = target.Interior.ColorIndex
If x = 16 Then Range("'FI'!B9").Interior.ColorIndex = x
                ActiveWorkbook.Sheets("MDD3").Tab.ColorIndex = x
End If
 
Case Range("B10").adress
x = target.Interior.ColorIndex
If x = 16 Then Range("'FI'!B10").Interior.ColorIndex = x
                ActiveWorkbook.Sheets("MDD4").Tab.ColorIndex = x
End If
 
Case Range("B11").adress
x = target.Interior.ColorIndex
If x = 16 Then Range("'FI'!B11").Interior.ColorIndex = x
                ActiveWorkbook.Sheets("MDD5").Tab.ColorIndex = x
End If
 
Case Range("B12").adress
x = target.Interior.ColorIndex
If x = 16 Then Range("'FI'!B12").Interior.ColorIndex = x
                ActiveWorkbook.Sheets("MDD6").Tab.ColorIndex = x
End If
 
Case Range("B13").adress
x = target.Interior.ColorIndex
If x = 16 Then Range("'FI'!B13").Interior.ColorIndex = x
                ActiveWorkbook.Sheets("MDD7").Tab.ColorIndex = x
End If
 
Case Range("B14").adress
x = target.Interior.ColorIndex
If x = 16 Then Range("'FI'!B14").Interior.ColorIndex = x
                ActiveWorkbook.Sheets("MDD8").Tab.ColorIndex = x
End If
 
Case Range("B15").adress
x = target.Interior.ColorIndex
If x = 16 Then Range("'FI'!B15").Interior.ColorIndex = x
                ActiveWorkbook.Sheets("MDD9").Tab.ColorIndex = x
End If
 
Case Range("B16").adress
x = target.Interior.ColorIndex
If x = 16 Then Range("'FI'!B16").Interior.ColorIndex = x
                ActiveWorkbook.Sheets("MDD10").Tab.ColorIndex = x
End If
 
Case Range("B17").adress
x = target.Interior.ColorIndex
If x = 16 Then Range("'FI'!B17").Interior.ColorIndex = x
                ActiveWorkbook.Sheets("MDD11").Tab.ColorIndex = x
End If
 
Case Range("B18").adress
x = target.Interior.ColorIndex
If x = 16 Then Range("'FI'!B18").Interior.ColorIndex = x
                ActiveWorkbook.Sheets("MDD12").Tab.ColorIndex = x
End If
 
Case Range("B19").adress
x = target.Interior.ColorIndex
If x = 16 Then Range("'FI'!B19").Interior.ColorIndex = x
                ActiveWorkbook.Sheets("MDD13").Tab.ColorIndex = x
End If
 
Case Range("B20").adress
x = target.Interior.ColorIndex
If x = 16 Then Range("'FI'!B20").Interior.ColorIndex = x
                ActiveWorkbook.Sheets("MDD14").Tab.ColorIndex = x
End If
 
Case Range("B21").adress
x = target.Interior.ColorIndex
If x = 16 Then Range("'FI'!B21").Interior.ColorIndex = x
                ActiveWorkbook.Sheets("MDD15").Tab.ColorIndex = x
End If
 
Case Range("B22").adress
x = target.Interior.ColorIndex
If x = 16 Then Range("'FI'!B22").Interior.ColorIndex = x
                ActiveWorkbook.Sheets("MDD16").Tab.ColorIndex = x
End If
 
Case Range("B23").adress
x = target.Interior.ColorIndex
If x = 16 Then Range("'FI'!B23").Interior.ColorIndex = x
                ActiveWorkbook.Sheets("MDD17").Tab.ColorIndex = x
End If
 
Case Range("B24").adress
x = target.Interior.ColorIndex
If x = 16 Then Range("'FI'!B24").Interior.ColorIndex = x
                ActiveWorkbook.Sheets("MDD18").Tab.ColorIndex = x
End If
 
Case Range("B25").adress
x = target.Interior.ColorIndex
If x = 16 Then Range("'FI'!B25").Interior.ColorIndex = x
                ActiveWorkbook.Sheets("MDD19").Tab.ColorIndex = x
End If
 
Case Range("B26").adress
x = target.Interior.ColorIndex
If x = 16 Then Range("'FI'!B26").Interior.ColorIndex = x
                ActiveWorkbook.Sheets("MDD20").Tab.ColorIndex = x
End If
 
Case Range("B29").adress
x = target.Interior.ColorIndex
If x = 16 Then Range("'FI'!B27").Interior.ColorIndex = x
                ActiveWorkbook.Sheets("MDD21").Tab.ColorIndex = x
End If
 
Case Range("B30").adress
x = target.Interior.ColorIndex
If x = 16 Then Range("'FI'!B28").Interior.ColorIndex = x
                ActiveWorkbook.Sheets("MDD22").Tab.ColorIndex = x
End If
 
Case Range("B31").adress
x = target.Interior.ColorIndex
If x = 16 Then Range("'FI'!B29").Interior.ColorIndex = x
                ActiveWorkbook.Sheets("MDD23").Tab.ColorIndex = x
End If
 
Case Range("B32").adress
x = target.Interior.ColorIndex
If x = 16 Then Range("'FI'!B30").Interior.ColorIndex = x
                ActiveWorkbook.Sheets("MDD24").Tab.ColorIndex = x
End If
 
Case Range("B33").adress
x = target.Interior.ColorIndex
If x = 16 Then Range("'FI'!B31").Interior.ColorIndex = x
                ActiveWorkbook.Sheets("MDD25").Tab.ColorIndex = x
End If
 
Case Range("B34").adress
x = target.Interior.ColorIndex
If x = 16 Then Range("'FI'!B32").Interior.ColorIndex = x
                ActiveWorkbook.Sheets("MDD26").Tab.ColorIndex = x
End If
 
Case Range("B35").adress
x = target.Interior.ColorIndex
If x = 16 Then Range("'FI'!B33").Interior.ColorIndex = x
                ActiveWorkbook.Sheets("MDD27").Tab.ColorIndex = x
End If
 
Case Range("B36").adress
x = target.Interior.ColorIndex
If x = 16 Then Range("'FI'!B34").Interior.ColorIndex = x
                ActiveWorkbook.Sheets("MDD28").Tab.ColorIndex = x
End If
 
Case Range("B37").adress
x = target.Interior.ColorIndex
If x = 16 Then Range("'FI'!B35").Interior.ColorIndex = x
                ActiveWorkbook.Sheets("MDD29").Tab.ColorIndex = x
End If
 
Case Range("B38").adress
x = target.Interior.ColorIndex
If x = 16 Then Range("'FI'!B36").Interior.ColorIndex = x
                ActiveWorkbook.Sheets("MDD30").Tab.ColorIndex = x
End If
 
Case Range("B39").adress
x = target.Interior.ColorIndex
If x = 16 Then Range("'FI'!B37").Interior.ColorIndex = x
                ActiveWorkbook.Sheets("MDD31").Tab.ColorIndex = x
End If
 
Case Range("B42").adress
x = target.Interior.ColorIndex
If x = 16 Then Range("'FI'!B38").Interior.ColorIndex = x
                ActiveWorkbook.Sheets("MDD32").Tab.ColorIndex = x
End If
 
End Select
End Sub

Merci !
Kulnae.

Ecouter un evenement sur une cellule et le reproduire sur une autre cellule

Macros et VBA Excel

Vue hybride

Discussions similaires

Partager

Partager