Logo GNT
Actualités Tests & Guides Bons Plans
GTA 6 iPhone 17 Copilot Switch 2 Temu ChatGPT Tesla
OVH Cloud OVH Cloud
Entraide Applications Microsoft Office Excel Mise ne forme conditionnellr par vba

Mise ne forme conditionnellr par vba

13 réponses
Avatar
Jacquouille Le Gaulois
Bonjour,

J'ai essaye de modifier le code envoye par Michdenis et cela ne marche
pas quelqu'un pourrais me dire ce qui cloche
Voici mon code ( de debutant...certainement ) :-Z


Private Sub Worksheet_change(ByVal Target As Range)
Dim c As Range
Dim Rg As Range

Set Rg = Worksheets("Feuil17").Range("B4")
Set Rg2 = Worksheets("Feuil17").Range("C4")
Set Rg3 = Worksheets("Feuil17").Range("D4")
Set Rg4 = Worksheets("Feuil17").Range("E4")
Set Rg5 = Worksheets("Feuil17").Range("F4")
Set Rg6 = Worksheets("Feuil17").Range("G4")
Set Rg7 = Worksheets("Feuil17").Range("H4")
Set Rg8 = Worksheets("Feuil17").Range("I4")
Set Rg9 = Worksheets("Feuil17").Range("J4")
Set Rg10 = Worksheets("Feuil17").Range("K4")
Set Rg11 = Worksheets("Feuil17").Range("L4")
Set Rg12 = Worksheets("Feuil17").Range("M4")
Set Rg13 = Worksheets("Feuil17").Range("N4")


If Not Intersect(Target, Range("C6:AG35")) Is Nothing Then
For Each c In Target
Select Case c.Value
Case Is = Rg.Value: c.Interior.ColorIndex = 21
Case Is = Rg2.Value: c.Interior.ColorIndex = 33
Case Is = Rg3.Value: c.Interior.ColorIndex = 30
Case Is = Rg4.Value: c.Interior.ColorIndex = 42
Case Is = Rg5.Value: c.Interior.ColorIndex = 2
Case Is = Rg6.Value: c.Interior.ColorIndex = 37
Case Is = Rg7.Value: c.Interior.ColorIndex = 38
Case Is = Rg8.Value: c.Interior.ColorIndex = 3
Case Is = Rg9.Value: c.Interior.ColorIndex = 6
Case Is = Rg10.Value: c.Interior.ColorIndex = 9
Case Is = Rg11.Value: c.Interior.ColorIndex = 10
Case Is = Rg12.Value: c.Interior.ColorIndex = 15
Case Is = Rg13.Value: c.Interior.ColorIndex = 8
Case Else: c.Interior.ColorIndex = xlNone
End Select
Next
End If
Set Rg = Nothing: Set c = Nothing
End Sub



Salutations!

--
("|`-''-/").___..--''"`-._
`6_ 6 ) `-. ( ).`-.__.`)
(_Y_.)' ._ ) `._ `. ``-..-'
_..`--'_..-_/ /--'_.' ,'
(il),-'' (li),' ((!.-'
Signaler un problème avec ce contenu

10 réponses

Supprimer
Cette action est irreversible, confirmez la suppression du commentaire ?
Signaler le commentaire

Veuillez sélectionner un problème

Nudité
Violence
Harcèlement
Fraude
Vente illégale
Discours haineux
Terrorisme
Autre
1 2
Avatar
Philippe.R
Bonjour Jacquouille Le Gaulois,
Qu'est ce qui ne fonctionne pas dans ton code ?
Peux tu préciser un t'it peu s'il te plait ?
A tout hasard, cette version convient elle mieux ?

Private Sub Worksheet_change(ByVal Target As Range)
Dim c As Range
Dim Rg As Range

Set Rg = Worksheets("Feuil2").Range("B4")
Set Rg2 = Worksheets("Feuil2").Range("C4")
Set Rg3 = Worksheets("Feuil2").Range("D4")
Set Rg4 = Worksheets("Feuil2").Range("E4")
Set Rg5 = Worksheets("Feuil2").Range("F4")
Set Rg6 = Worksheets("Feuil2").Range("G4")
Set Rg7 = Worksheets("Feuil2").Range("H4")
Set Rg8 = Worksheets("Feuil2").Range("I4")
Set Rg9 = Worksheets("Feuil2").Range("J4")
Set Rg10 = Worksheets("Feuil2").Range("K4")
Set Rg11 = Worksheets("Feuil2").Range("L4")
Set Rg12 = Worksheets("Feuil2").Range("M4")
Set Rg13 = Worksheets("Feuil2").Range("N4")


If Not Intersect(Target, Range("C6:AG35")) Is Nothing Then
For Each c In Target
Select Case c.Value
Case Is = Rg.Value: c.Interior.ColorIndex = 21
Case Is = Rg2.Value: c.Interior.ColorIndex = 33
Case Is = Rg3.Value: c.Interior.ColorIndex = 30
Case Is = Rg4.Value: c.Interior.ColorIndex = 42
Case Is = Rg5.Value: c.Interior.ColorIndex = 2
Case Is = Rg6.Value: c.Interior.ColorIndex = 37
Case Is = Rg7.Value: c.Interior.ColorIndex = 38
Case Is = Rg8.Value: c.Interior.ColorIndex = 3
Case Is = Rg9.Value: c.Interior.ColorIndex = 6
Case Is = Rg10.Value: c.Interior.ColorIndex = 9
Case Is = Rg11.Value: c.Interior.ColorIndex = 10
Case Is = Rg12.Value: c.Interior.ColorIndex = 15
Case Is = Rg13.Value: c.Interior.ColorIndex = 8
Case Else: c.Interior.ColorIndex = xlNone
End Select
Next
Else
ActiveCell.Interior.ColorIndex = xlNone
Exit Sub
End If
Calculate
Set Rg = Nothing: Set c = Nothing
End Sub

--
Amicales Salutations

Retirer A_S_ pour répondre.
XL97 / XL2002

"Jacquouille Le Gaulois" a écrit dans le message de
news:
Bonjour,

J'ai essaye de modifier le code envoye par Michdenis et cela ne marche
pas quelqu'un pourrais me dire ce qui cloche
Voici mon code ( de debutant...certainement ) :-Z


Private Sub Worksheet_change(ByVal Target As Range)
Dim c As Range
Dim Rg As Range

Set Rg = Worksheets("Feuil17").Range("B4")
Set Rg2 = Worksheets("Feuil17").Range("C4")
Set Rg3 = Worksheets("Feuil17").Range("D4")
Set Rg4 = Worksheets("Feuil17").Range("E4")
Set Rg5 = Worksheets("Feuil17").Range("F4")
Set Rg6 = Worksheets("Feuil17").Range("G4")
Set Rg7 = Worksheets("Feuil17").Range("H4")
Set Rg8 = Worksheets("Feuil17").Range("I4")
Set Rg9 = Worksheets("Feuil17").Range("J4")
Set Rg10 = Worksheets("Feuil17").Range("K4")
Set Rg11 = Worksheets("Feuil17").Range("L4")
Set Rg12 = Worksheets("Feuil17").Range("M4")
Set Rg13 = Worksheets("Feuil17").Range("N4")


If Not Intersect(Target, Range("C6:AG35")) Is Nothing Then
For Each c In Target
Select Case c.Value
Case Is = Rg.Value: c.Interior.ColorIndex = 21
Case Is = Rg2.Value: c.Interior.ColorIndex = 33
Case Is = Rg3.Value: c.Interior.ColorIndex = 30
Case Is = Rg4.Value: c.Interior.ColorIndex = 42
Case Is = Rg5.Value: c.Interior.ColorIndex = 2
Case Is = Rg6.Value: c.Interior.ColorIndex = 37
Case Is = Rg7.Value: c.Interior.ColorIndex = 38
Case Is = Rg8.Value: c.Interior.ColorIndex = 3
Case Is = Rg9.Value: c.Interior.ColorIndex = 6
Case Is = Rg10.Value: c.Interior.ColorIndex = 9
Case Is = Rg11.Value: c.Interior.ColorIndex = 10
Case Is = Rg12.Value: c.Interior.ColorIndex = 15
Case Is = Rg13.Value: c.Interior.ColorIndex = 8
Case Else: c.Interior.ColorIndex = xlNone
End Select
Next
End If
Set Rg = Nothing: Set c = Nothing
End Sub



Salutations!

--
("|`-''-/").___..--''"`-._
`6_ 6 ) `-. ( ).`-.__.`)
(_Y_.)' ._ ) `._ `. ``-..-'
_..`--'_..-_/ /--'_.' ,'
(il),-'' (li),' ((!.-'



Avatar
Jacquouille Le Gaulois
Bonjour, PhilippeR

:-Z j'ai trouve mon erreur suite a ton poste, en effet j'ai remplace
feuil2 par le nom de ma feuille "code" et tous fonctionne tres bien.



Philippe.R a exposé le 28/02/2004 :
Private Sub Worksheet_change(ByVal Target As Range)
Dim c As Range
Dim Rg As Range

Set Rg = Worksheets("Feuil2").Range("B4")
Set Rg2 = Worksheets("Feuil2").Range("C4")
Set Rg3 = Worksheets("Feuil2").Range("D4")
Set Rg4 = Worksheets("Feuil2").Range("E4")
Set Rg5 = Worksheets("Feuil2").Range("F4")
Set Rg6 = Worksheets("Feuil2").Range("G4")
Set Rg7 = Worksheets("Feuil2").Range("H4")
Set Rg8 = Worksheets("Feuil2").Range("I4")
Set Rg9 = Worksheets("Feuil2").Range("J4")
Set Rg10 = Worksheets("Feuil2").Range("K4")
Set Rg11 = Worksheets("Feuil2").Range("L4")
Set Rg12 = Worksheets("Feuil2").Range("M4")
Set Rg13 = Worksheets("Feuil2").Range("N4")


If Not Intersect(Target, Range("C6:AG35")) Is Nothing Then
For Each c In Target
Select Case c.Value
Case Is = Rg.Value: c.Interior.ColorIndex = 21
Case Is = Rg2.Value: c.Interior.ColorIndex = 33
Case Is = Rg3.Value: c.Interior.ColorIndex = 30
Case Is = Rg4.Value: c.Interior.ColorIndex = 42
Case Is = Rg5.Value: c.Interior.ColorIndex = 2
Case Is = Rg6.Value: c.Interior.ColorIndex = 37
Case Is = Rg7.Value: c.Interior.ColorIndex = 38
Case Is = Rg8.Value: c.Interior.ColorIndex = 3
Case Is = Rg9.Value: c.Interior.ColorIndex = 6
Case Is = Rg10.Value: c.Interior.ColorIndex = 9
Case Is = Rg11.Value: c.Interior.ColorIndex = 10
Case Is = Rg12.Value: c.Interior.ColorIndex = 15
Case Is = Rg13.Value: c.Interior.ColorIndex = 8
Case Else: c.Interior.ColorIndex = xlNone
End Select
Next
Else
ActiveCell.Interior.ColorIndex = xlNone
Exit Sub
End If
Calculate
Set Rg = Nothing: Set c = Nothing
End Sub


--
("|`-''-/").___..--''"`-._
`6_ 6 ) `-. ( ).`-.__.`)
(_Y_.)' ._ ) `._ `. ``-..-'
_..`--'_..-_/ /--'_.' ,'
(il),-'' (li),' ((!.-'

Avatar
Michel Gaboly
Salut Philippe,

Il y a pourtant de nombreuses remarques à faire sur son code.
Ceci dit, s'il est débutant, c'est parfaitement normal ;-)))

1 - Le code associé à un événement de feuille doit être dans le
module de la feuille. Il est donc inutile de qualifier un objet
Range de la feuille avec le nom de celle-ci ; 3 inconvénients :

- Plus long à écrire
- Moins lisible
- Et surtout, cesse de fonctionner si la feuille est renommée.

2 - Si on déclare les variables avec Dim, il faut le faire pour toutes
et pas seulement pour Cell et Rg. Pour cela, il vaut mieux dans les
préférences de VBA, cocher "Déclaration explicite des variables"
(onglet éditeur).

3 - Pour tester une égalité, Case Toto est + simple et + lisible
que Case Is = Toto.

4 - Le For Each c In Target doit être remplacé par

For Each c In Intersect(Target, Range("C6:AG35"))

sous peine de colorier des cellules qui n'appartiennent pas à
la plage C6:AG35 si l'intersection entre cette plage et Target
n'est pas vide (cf. mon message de dimanche dernier à 10h38
heure de Paris), en réponse à ChrisV.

5 - Lorsque comme ici, un même schéma se répète, il faut essayer
de remplacer les lignes successives qui se ressemblent par une
boucle. On y arrive aisément ici, car les cellules constituant Rg à
Rg13 sont contigües, ce qui permet l'emploi d'un Offset et l'économie
de ces 13 variables objet, en utilisant un Array pour les valeurs à
utiliser pour ColorIndex :

Private Sub Worksheet_Change(ByVal Target As Excel.Range)
Dim c As Range, Mat, i As Integer
Mat = Array(21, 33, 30, 42, 2, 37, 38, 3, 6, 9, 10, 15, 8)
If Not Intersect(Target, Range("C6:AG35")) Is Nothing Then
' MEFC
For Each c In Intersect(Target, Range("C6:AG35"))
For i = 0 To 12
If c = Range("B4").Offset(0, i) Then
c.Interior.ColorIndex = Mat(i)
Exit For
Else
c.Interior.ColorIndex = xlNone
End If
Next i
Next c
End If
End Sub




Bonjour Jacquouille Le Gaulois,
Qu'est ce qui ne fonctionne pas dans ton code ?
Peux tu préciser un t'it peu s'il te plait ?
A tout hasard, cette version convient elle mieux ?

Private Sub Worksheet_change(ByVal Target As Range)
Dim c As Range
Dim Rg As Range

Set Rg = Worksheets("Feuil2").Range("B4")
Set Rg2 = Worksheets("Feuil2").Range("C4")
Set Rg3 = Worksheets("Feuil2").Range("D4")
Set Rg4 = Worksheets("Feuil2").Range("E4")
Set Rg5 = Worksheets("Feuil2").Range("F4")
Set Rg6 = Worksheets("Feuil2").Range("G4")
Set Rg7 = Worksheets("Feuil2").Range("H4")
Set Rg8 = Worksheets("Feuil2").Range("I4")
Set Rg9 = Worksheets("Feuil2").Range("J4")
Set Rg10 = Worksheets("Feuil2").Range("K4")
Set Rg11 = Worksheets("Feuil2").Range("L4")
Set Rg12 = Worksheets("Feuil2").Range("M4")
Set Rg13 = Worksheets("Feuil2").Range("N4")

If Not Intersect(Target, Range("C6:AG35")) Is Nothing Then
For Each c In Target
Select Case c.Value
Case Is = Rg.Value: c.Interior.ColorIndex = 21
Case Is = Rg2.Value: c.Interior.ColorIndex = 33
Case Is = Rg3.Value: c.Interior.ColorIndex = 30
Case Is = Rg4.Value: c.Interior.ColorIndex = 42
Case Is = Rg5.Value: c.Interior.ColorIndex = 2
Case Is = Rg6.Value: c.Interior.ColorIndex = 37
Case Is = Rg7.Value: c.Interior.ColorIndex = 38
Case Is = Rg8.Value: c.Interior.ColorIndex = 3
Case Is = Rg9.Value: c.Interior.ColorIndex = 6
Case Is = Rg10.Value: c.Interior.ColorIndex = 9
Case Is = Rg11.Value: c.Interior.ColorIndex = 10
Case Is = Rg12.Value: c.Interior.ColorIndex = 15
Case Is = Rg13.Value: c.Interior.ColorIndex = 8
Case Else: c.Interior.ColorIndex = xlNone
End Select
Next
Else
ActiveCell.Interior.ColorIndex = xlNone
Exit Sub
End If
Calculate
Set Rg = Nothing: Set c = Nothing
End Sub

--
Amicales Salutations

Retirer A_S_ pour répondre.
XL97 / XL2002

"Jacquouille Le Gaulois" a écrit dans le message de
news:
Bonjour,

J'ai essaye de modifier le code envoye par Michdenis et cela ne marche
pas quelqu'un pourrais me dire ce qui cloche
Voici mon code ( de debutant...certainement ) :-Z


Private Sub Worksheet_change(ByVal Target As Range)
Dim c As Range
Dim Rg As Range

Set Rg = Worksheets("Feuil17").Range("B4")
Set Rg2 = Worksheets("Feuil17").Range("C4")
Set Rg3 = Worksheets("Feuil17").Range("D4")
Set Rg4 = Worksheets("Feuil17").Range("E4")
Set Rg5 = Worksheets("Feuil17").Range("F4")
Set Rg6 = Worksheets("Feuil17").Range("G4")
Set Rg7 = Worksheets("Feuil17").Range("H4")
Set Rg8 = Worksheets("Feuil17").Range("I4")
Set Rg9 = Worksheets("Feuil17").Range("J4")
Set Rg10 = Worksheets("Feuil17").Range("K4")
Set Rg11 = Worksheets("Feuil17").Range("L4")
Set Rg12 = Worksheets("Feuil17").Range("M4")
Set Rg13 = Worksheets("Feuil17").Range("N4")


If Not Intersect(Target, Range("C6:AG35")) Is Nothing Then
For Each c In Target
Select Case c.Value
Case Is = Rg.Value: c.Interior.ColorIndex = 21
Case Is = Rg2.Value: c.Interior.ColorIndex = 33
Case Is = Rg3.Value: c.Interior.ColorIndex = 30
Case Is = Rg4.Value: c.Interior.ColorIndex = 42
Case Is = Rg5.Value: c.Interior.ColorIndex = 2
Case Is = Rg6.Value: c.Interior.ColorIndex = 37
Case Is = Rg7.Value: c.Interior.ColorIndex = 38
Case Is = Rg8.Value: c.Interior.ColorIndex = 3
Case Is = Rg9.Value: c.Interior.ColorIndex = 6
Case Is = Rg10.Value: c.Interior.ColorIndex = 9
Case Is = Rg11.Value: c.Interior.ColorIndex = 10
Case Is = Rg12.Value: c.Interior.ColorIndex = 15
Case Is = Rg13.Value: c.Interior.ColorIndex = 8
Case Else: c.Interior.ColorIndex = xlNone
End Select
Next
End If
Set Rg = Nothing: Set c = Nothing
End Sub



Salutations!

--
("|`-''-/").___..--''"`-._
`6_ 6 ) `-. ( ).`-.__.`)
(_Y_.)' ._ ) `._ `. ``-..-'
_..`--'_..-_/ /--'_.' ,'
(il),-'' (li),' ((!.-'




--
Cordialement,

Michel Gaboly
http://www.gaboly.com


Avatar
Jacquouille Le Gaulois
Bonjour Michel Gaboly,

En effet je suis debutant et j essaye de me prefectionner par le biaie
de ce forum.
J ai essaye ton code avec array :'( il ne fonctionne pas, en effet jai
un classeur avec une feuille par mois et une feuille qui me sert de
code.
Ce que je veux c est que si je mets en "B4" sur ma feuille "Code" la
lettre "G" par exemple et qu ensuite je saisi dans une de mes feuilles
mois dans une des cellules de la plages "C6:AG35" le valeurs "G" alors
la cellule se coloris d'une certaine couleur

merci


Michel Gaboly a exprimé avec précision :
Private Sub Worksheet_Change(ByVal Target As Excel.Range)
Dim c As Range, Mat, i As Integer
Mat = Array(21, 33, 30, 42, 2, 37, 38, 3, 6, 9, 10, 15, 8)
If Not Intersect(Target, Range("C6:AG35")) Is Nothing Then
' MEFC
For Each c In Intersect(Target, Range("C6:AG35"))
For i = 0 To 12
If c = Range("B4").Offset(0, i) Then
c.Interior.ColorIndex = Mat(i)
Exit For
Else
c.Interior.ColorIndex = xlNone
End If
Next i
Next c
End If
End Sub


--
("|`-''-/").___..--''"`-._
`6_ 6 ) `-. ( ).`-.__.`)
(_Y_.)' ._ ) `._ `. ``-..-'
_..`--'_..-_/ /--'_.' ,'
(il),-'' (li),' ((!.-'

Avatar
Michel Gaboly
Re,

Ce n'est pas vraiment qu'il ne fonctionne pas ;-))

Simplement la comparaison se fait avec les cellules de la ligne 4 de la
feuille active. Pour comparer avec les données de la feuille "Code",

remplace simplement la ligne

If c = Range("B4").Offset(0, i) Then

par

If c = Sheets("Code").Range("B4").Offset(0, i) Then

et code cette version modifiée dans le module de chacune des feuilles
mensuelles.

ou mieux,

copie ceci dans le module de chaque feuille mensuelle :

Private Sub Worksheet_Change(ByVal Target As Excel.Range)
Dim c As Range, i As Integer
If Not Intersect(Target, Range("C6:AG35")) Is Nothing Then
' MEFC
For Each c In Intersect(Target, Range("C6:AG35"))
Compare c
Next c
End If
End Sub

et cela dans un module standard :

Sub Compare(c As Range)
Dim Mat, i As Integer
Mat = Array(21, 33, 30, 42, 2, 37, 38, 3, 6, 9, 10, 15, 8)
For i = 0 To 12
If c = Sheets("Code").Range("B4").Offset(0, i) Then
c.Interior.ColorIndex = Mat(i)
Exit For
Else
c.Interior.ColorIndex = xlNone
End If
Next i
End Sub

L'intérêt est que si tu veux modifier les codes couleurs, tu n'auras à
le faire qu'une fois.



Bonjour Michel Gaboly,

En effet je suis debutant et j essaye de me prefectionner par le biaie
de ce forum.
J ai essaye ton code avec array :'( il ne fonctionne pas, en effet jai
un classeur avec une feuille par mois et une feuille qui me sert de
code.
Ce que je veux c est que si je mets en "B4" sur ma feuille "Code" la
lettre "G" par exemple et qu ensuite je saisi dans une de mes feuilles
mois dans une des cellules de la plages "C6:AG35" le valeurs "G" alors
la cellule se coloris d'une certaine couleur

merci

Michel Gaboly a exprimé avec précision :
Private Sub Worksheet_Change(ByVal Target As Excel.Range)
Dim c As Range, Mat, i As Integer
Mat = Array(21, 33, 30, 42, 2, 37, 38, 3, 6, 9, 10, 15, 8)
If Not Intersect(Target, Range("C6:AG35")) Is Nothing Then
' MEFC
For Each c In Intersect(Target, Range("C6:AG35"))
For i = 0 To 12
If c = Range("B4").Offset(0, i) Then
c.Interior.ColorIndex = Mat(i)
Exit For
Else
c.Interior.ColorIndex = xlNone
End If
Next i
Next c
End If
End Sub


--
("|`-''-/").___..--''"`-._
`6_ 6 ) `-. ( ).`-.__.`)
(_Y_.)' ._ ) `._ `. ``-..-'
_..`--'_..-_/ /--'_.' ,'
(il),-'' (li),' ((!.-'


--
Cordialement,

Michel Gaboly
http://www.gaboly.com


Avatar
Jacquouille Le Gaulois
Michel Gaboly a utilisé son clavier pour écrire :
Re,

Ce n'est pas vraiment qu'il ne fonctionne pas ;-))

Simplement la comparaison se fait avec les cellules de la ligne 4 de la
feuille active. Pour comparer avec les données de la feuille "Code",

remplace simplement la ligne

If c = Range("B4").Offset(0, i) Then

par

If c = Sheets("Code").Range("B4").Offset(0,
i) Then

et code cette version modifiée dans le module de chacune des feuilles
mensuelles.

ou mieux,

copie ceci dans le module de chaque feuille mensuelle :

Private Sub Worksheet_Change(ByVal Target As Excel.Range)
Dim c As Range, i As Integer
If Not Intersect(Target, Range("C6:AG35")) Is Nothing Then
' MEFC
For Each c In Intersect(Target, Range("C6:AG35"))
Compare c
Next c
End If
End Sub

et cela dans un module standard :

Sub Compare(c As Range)
Dim Mat, i As Integer
Mat = Array(21, 33, 30, 42, 2, 37, 38, 3, 6, 9, 10, 15, 8)
For i = 0 To 12
If c = Sheets("Code").Range("B4").Offset(0, i) Then
c.Interior.ColorIndex = Mat(i)
Exit For
Else
c.Interior.ColorIndex = xlNone
End If
Next i
End Sub

L'intérêt est que si tu veux modifier les codes couleurs, tu n'auras à
le faire qu'une fois.



Bonjour Michel Gaboly,

En effet je suis debutant et j essaye de me prefectionner par le biaie
de ce forum.
J ai essaye ton code avec array :'( il ne fonctionne pas, en effet jai
un classeur avec une feuille par mois et une feuille qui me sert de
code.
Ce que je veux c est que si je mets en "B4" sur ma feuille "Code" la
lettre "G" par exemple et qu ensuite je saisi dans une de mes feuilles
mois dans une des cellules de la plages "C6:AG35" le valeurs "G" alors
la cellule se coloris d'une certaine couleur

merci
Merci beaucoup ;-)




Michel Gaboly a exprimé avec précision :
Private Sub Worksheet_Change(ByVal Target As Excel.Range)
Dim c As Range, Mat, i As Integer
Mat = Array(21, 33, 30, 42, 2, 37, 38, 3, 6, 9, 10, 15, 8)
If Not Intersect(Target, Range("C6:AG35")) Is Nothing Then
' MEFC
For Each c In Intersect(Target, Range("C6:AG35"))
For i = 0 To 12
If c = Range("B4").Offset(0, i) Then
c.Interior.ColorIndex = Mat(i)
Exit For
Else
c.Interior.ColorIndex = xlNone
End If
Next i
Next c
End If
End Sub


--
("|`-''-/").___..--''"`-._
`6_ 6 ) `-. ( ).`-.__.`)
(_Y_.)' ._ ) `._ `. ``-..-'
_..`--'_..-_/ /--'_.' ,'
(il),-'' (li),' ((!.-'



--
("|`-''-/").___..--''"`-._
`6_ 6 ) `-. ( ).`-.__.`)
(_Y_.)' ._ ) `._ `. ``-..-'
_..`--'_..-_/ /--'_.' ,'
(il),-'' (li),' ((!.-'



Avatar
Philippe.R
Bonjour Michel,
Merci pour ce cours !
Ah ! si tu n'étais là, dans quel abîme d'ignorance ne sombrerions nous pas !
;o))))))
--
Amicales Salutations

"Michel Gaboly" a écrit dans le message de
news:
Salut Philippe,

Il y a pourtant de nombreuses remarques à faire sur son code.
Ceci dit, s'il est débutant, c'est parfaitement normal ;-)))

1 - Le code associé à un événement de feuille doit être dans le
module de la feuille. Il est donc inutile de qualifier un objet
Range de la feuille avec le nom de celle-ci ; 3 inconvénients :

- Plus long à écrire
- Moins lisible
- Et surtout, cesse de fonctionner si la feuille est renommée.

2 - Si on déclare les variables avec Dim, il faut le faire pour toutes
et pas seulement pour Cell et Rg. Pour cela, il vaut mieux dans les
préférences de VBA, cocher "Déclaration explicite des variables"
(onglet éditeur).

3 - Pour tester une égalité, Case Toto est + simple et + lisible
que Case Is = Toto.

4 - Le For Each c In Target doit être remplacé par

For Each c In Intersect(Target, Range("C6:AG35"))

sous peine de colorier des cellules qui n'appartiennent pas à
la plage C6:AG35 si l'intersection entre cette plage et Target
n'est pas vide (cf. mon message de dimanche dernier à 10h38
heure de Paris), en réponse à ChrisV.

5 - Lorsque comme ici, un même schéma se répète, il faut essayer
de remplacer les lignes successives qui se ressemblent par une
boucle. On y arrive aisément ici, car les cellules constituant Rg à
Rg13 sont contigües, ce qui permet l'emploi d'un Offset et l'économie
de ces 13 variables objet, en utilisant un Array pour les valeurs à
utiliser pour ColorIndex :

Private Sub Worksheet_Change(ByVal Target As Excel.Range)
Dim c As Range, Mat, i As Integer
Mat = Array(21, 33, 30, 42, 2, 37, 38, 3, 6, 9, 10, 15, 8)
If Not Intersect(Target, Range("C6:AG35")) Is Nothing Then
' MEFC
For Each c In Intersect(Target, Range("C6:AG35"))
For i = 0 To 12
If c = Range("B4").Offset(0, i) Then
c.Interior.ColorIndex = Mat(i)
Exit For
Else
c.Interior.ColorIndex = xlNone
End If
Next i
Next c
End If
End Sub




Bonjour Jacquouille Le Gaulois,
Qu'est ce qui ne fonctionne pas dans ton code ?
Peux tu préciser un t'it peu s'il te plait ?
A tout hasard, cette version convient elle mieux ?

Private Sub Worksheet_change(ByVal Target As Range)
Dim c As Range
Dim Rg As Range

Set Rg = Worksheets("Feuil2").Range("B4")
Set Rg2 = Worksheets("Feuil2").Range("C4")
Set Rg3 = Worksheets("Feuil2").Range("D4")
Set Rg4 = Worksheets("Feuil2").Range("E4")
Set Rg5 = Worksheets("Feuil2").Range("F4")
Set Rg6 = Worksheets("Feuil2").Range("G4")
Set Rg7 = Worksheets("Feuil2").Range("H4")
Set Rg8 = Worksheets("Feuil2").Range("I4")
Set Rg9 = Worksheets("Feuil2").Range("J4")
Set Rg10 = Worksheets("Feuil2").Range("K4")
Set Rg11 = Worksheets("Feuil2").Range("L4")
Set Rg12 = Worksheets("Feuil2").Range("M4")
Set Rg13 = Worksheets("Feuil2").Range("N4")

If Not Intersect(Target, Range("C6:AG35")) Is Nothing Then
For Each c In Target
Select Case c.Value
Case Is = Rg.Value: c.Interior.ColorIndex = 21
Case Is = Rg2.Value: c.Interior.ColorIndex = 33
Case Is = Rg3.Value: c.Interior.ColorIndex = 30
Case Is = Rg4.Value: c.Interior.ColorIndex = 42
Case Is = Rg5.Value: c.Interior.ColorIndex = 2
Case Is = Rg6.Value: c.Interior.ColorIndex = 37
Case Is = Rg7.Value: c.Interior.ColorIndex = 38
Case Is = Rg8.Value: c.Interior.ColorIndex = 3
Case Is = Rg9.Value: c.Interior.ColorIndex = 6
Case Is = Rg10.Value: c.Interior.ColorIndex = 9
Case Is = Rg11.Value: c.Interior.ColorIndex = 10
Case Is = Rg12.Value: c.Interior.ColorIndex = 15
Case Is = Rg13.Value: c.Interior.ColorIndex = 8
Case Else: c.Interior.ColorIndex = xlNone
End Select
Next
Else
ActiveCell.Interior.ColorIndex = xlNone
Exit Sub
End If
Calculate
Set Rg = Nothing: Set c = Nothing
End Sub

--
Amicales Salutations

Retirer A_S_ pour répondre.
XL97 / XL2002

"Jacquouille Le Gaulois" a écrit dans le message de
news:
Bonjour,

J'ai essaye de modifier le code envoye par Michdenis et cela ne marche
pas quelqu'un pourrais me dire ce qui cloche
Voici mon code ( de debutant...certainement ) :-Z


Private Sub Worksheet_change(ByVal Target As Range)
Dim c As Range
Dim Rg As Range

Set Rg = Worksheets("Feuil17").Range("B4")
Set Rg2 = Worksheets("Feuil17").Range("C4")
Set Rg3 = Worksheets("Feuil17").Range("D4")
Set Rg4 = Worksheets("Feuil17").Range("E4")
Set Rg5 = Worksheets("Feuil17").Range("F4")
Set Rg6 = Worksheets("Feuil17").Range("G4")
Set Rg7 = Worksheets("Feuil17").Range("H4")
Set Rg8 = Worksheets("Feuil17").Range("I4")
Set Rg9 = Worksheets("Feuil17").Range("J4")
Set Rg10 = Worksheets("Feuil17").Range("K4")
Set Rg11 = Worksheets("Feuil17").Range("L4")
Set Rg12 = Worksheets("Feuil17").Range("M4")
Set Rg13 = Worksheets("Feuil17").Range("N4")


If Not Intersect(Target, Range("C6:AG35")) Is Nothing Then
For Each c In Target
Select Case c.Value
Case Is = Rg.Value: c.Interior.ColorIndex = 21
Case Is = Rg2.Value: c.Interior.ColorIndex = 33
Case Is = Rg3.Value: c.Interior.ColorIndex = 30
Case Is = Rg4.Value: c.Interior.ColorIndex = 42
Case Is = Rg5.Value: c.Interior.ColorIndex = 2
Case Is = Rg6.Value: c.Interior.ColorIndex = 37
Case Is = Rg7.Value: c.Interior.ColorIndex = 38
Case Is = Rg8.Value: c.Interior.ColorIndex = 3
Case Is = Rg9.Value: c.Interior.ColorIndex = 6
Case Is = Rg10.Value: c.Interior.ColorIndex = 9
Case Is = Rg11.Value: c.Interior.ColorIndex = 10
Case Is = Rg12.Value: c.Interior.ColorIndex = 15
Case Is = Rg13.Value: c.Interior.ColorIndex = 8
Case Else: c.Interior.ColorIndex = xlNone
End Select
Next
End If
Set Rg = Nothing: Set c = Nothing
End Sub



Salutations!

--
("|`-''-/").___..--''"`-._
`6_ 6 ) `-. ( ).`-.__.`)
(_Y_.)' ._ ) `._ `. ``-..-'
_..`--'_..-_/ /--'_.' ,'
(il),-'' (li),' ((!.-'




--
Cordialement,

Michel Gaboly
http://www.gaboly.com






Avatar
Michel Gaboly
Bonjour Philippe

On se moque, je le sesn bien ;-)))

À bientôt à Seaulieu ?



Bonjour Michel,
Merci pour ce cours !
Ah ! si tu n'étais là, dans quel abîme d'ignorance ne sombrerions nous pas !
;o))))))
--
Amicales Salutations

"Michel Gaboly" a écrit dans le message de
news:
Salut Philippe,

Il y a pourtant de nombreuses remarques à faire sur son code.
Ceci dit, s'il est débutant, c'est parfaitement normal ;-)))

1 - Le code associé à un événement de feuille doit être dans le
module de la feuille. Il est donc inutile de qualifier un objet
Range de la feuille avec le nom de celle-ci ; 3 inconvénients :

- Plus long à écrire
- Moins lisible
- Et surtout, cesse de fonctionner si la feuille est renommée.

2 - Si on déclare les variables avec Dim, il faut le faire pour toutes
et pas seulement pour Cell et Rg. Pour cela, il vaut mieux dans les
préférences de VBA, cocher "Déclaration explicite des variables"
(onglet éditeur).

3 - Pour tester une égalité, Case Toto est + simple et + lisible
que Case Is = Toto.

4 - Le For Each c In Target doit être remplacé par

For Each c In Intersect(Target, Range("C6:AG35"))

sous peine de colorier des cellules qui n'appartiennent pas à
la plage C6:AG35 si l'intersection entre cette plage et Target
n'est pas vide (cf. mon message de dimanche dernier à 10h38
heure de Paris), en réponse à ChrisV.

5 - Lorsque comme ici, un même schéma se répète, il faut essayer
de remplacer les lignes successives qui se ressemblent par une
boucle. On y arrive aisément ici, car les cellules constituant Rg à
Rg13 sont contigües, ce qui permet l'emploi d'un Offset et l'économie
de ces 13 variables objet, en utilisant un Array pour les valeurs à
utiliser pour ColorIndex :

Private Sub Worksheet_Change(ByVal Target As Excel.Range)
Dim c As Range, Mat, i As Integer
Mat = Array(21, 33, 30, 42, 2, 37, 38, 3, 6, 9, 10, 15, 8)
If Not Intersect(Target, Range("C6:AG35")) Is Nothing Then
' MEFC
For Each c In Intersect(Target, Range("C6:AG35"))
For i = 0 To 12
If c = Range("B4").Offset(0, i) Then
c.Interior.ColorIndex = Mat(i)
Exit For
Else
c.Interior.ColorIndex = xlNone
End If
Next i
Next c
End If
End Sub




Bonjour Jacquouille Le Gaulois,
Qu'est ce qui ne fonctionne pas dans ton code ?
Peux tu préciser un t'it peu s'il te plait ?
A tout hasard, cette version convient elle mieux ?

Private Sub Worksheet_change(ByVal Target As Range)
Dim c As Range
Dim Rg As Range

Set Rg = Worksheets("Feuil2").Range("B4")
Set Rg2 = Worksheets("Feuil2").Range("C4")
Set Rg3 = Worksheets("Feuil2").Range("D4")
Set Rg4 = Worksheets("Feuil2").Range("E4")
Set Rg5 = Worksheets("Feuil2").Range("F4")
Set Rg6 = Worksheets("Feuil2").Range("G4")
Set Rg7 = Worksheets("Feuil2").Range("H4")
Set Rg8 = Worksheets("Feuil2").Range("I4")
Set Rg9 = Worksheets("Feuil2").Range("J4")
Set Rg10 = Worksheets("Feuil2").Range("K4")
Set Rg11 = Worksheets("Feuil2").Range("L4")
Set Rg12 = Worksheets("Feuil2").Range("M4")
Set Rg13 = Worksheets("Feuil2").Range("N4")

If Not Intersect(Target, Range("C6:AG35")) Is Nothing Then
For Each c In Target
Select Case c.Value
Case Is = Rg.Value: c.Interior.ColorIndex = 21
Case Is = Rg2.Value: c.Interior.ColorIndex = 33
Case Is = Rg3.Value: c.Interior.ColorIndex = 30
Case Is = Rg4.Value: c.Interior.ColorIndex = 42
Case Is = Rg5.Value: c.Interior.ColorIndex = 2
Case Is = Rg6.Value: c.Interior.ColorIndex = 37
Case Is = Rg7.Value: c.Interior.ColorIndex = 38
Case Is = Rg8.Value: c.Interior.ColorIndex = 3
Case Is = Rg9.Value: c.Interior.ColorIndex = 6
Case Is = Rg10.Value: c.Interior.ColorIndex = 9
Case Is = Rg11.Value: c.Interior.ColorIndex = 10
Case Is = Rg12.Value: c.Interior.ColorIndex = 15
Case Is = Rg13.Value: c.Interior.ColorIndex = 8
Case Else: c.Interior.ColorIndex = xlNone
End Select
Next
Else
ActiveCell.Interior.ColorIndex = xlNone
Exit Sub
End If
Calculate
Set Rg = Nothing: Set c = Nothing
End Sub

--
Amicales Salutations

Retirer A_S_ pour répondre.
XL97 / XL2002

"Jacquouille Le Gaulois" a écrit dans le message de
news:
Bonjour,

J'ai essaye de modifier le code envoye par Michdenis et cela ne marche
pas quelqu'un pourrais me dire ce qui cloche
Voici mon code ( de debutant...certainement ) :-Z


Private Sub Worksheet_change(ByVal Target As Range)
Dim c As Range
Dim Rg As Range

Set Rg = Worksheets("Feuil17").Range("B4")
Set Rg2 = Worksheets("Feuil17").Range("C4")
Set Rg3 = Worksheets("Feuil17").Range("D4")
Set Rg4 = Worksheets("Feuil17").Range("E4")
Set Rg5 = Worksheets("Feuil17").Range("F4")
Set Rg6 = Worksheets("Feuil17").Range("G4")
Set Rg7 = Worksheets("Feuil17").Range("H4")
Set Rg8 = Worksheets("Feuil17").Range("I4")
Set Rg9 = Worksheets("Feuil17").Range("J4")
Set Rg10 = Worksheets("Feuil17").Range("K4")
Set Rg11 = Worksheets("Feuil17").Range("L4")
Set Rg12 = Worksheets("Feuil17").Range("M4")
Set Rg13 = Worksheets("Feuil17").Range("N4")


If Not Intersect(Target, Range("C6:AG35")) Is Nothing Then
For Each c In Target
Select Case c.Value
Case Is = Rg.Value: c.Interior.ColorIndex = 21
Case Is = Rg2.Value: c.Interior.ColorIndex = 33
Case Is = Rg3.Value: c.Interior.ColorIndex = 30
Case Is = Rg4.Value: c.Interior.ColorIndex = 42
Case Is = Rg5.Value: c.Interior.ColorIndex = 2
Case Is = Rg6.Value: c.Interior.ColorIndex = 37
Case Is = Rg7.Value: c.Interior.ColorIndex = 38
Case Is = Rg8.Value: c.Interior.ColorIndex = 3
Case Is = Rg9.Value: c.Interior.ColorIndex = 6
Case Is = Rg10.Value: c.Interior.ColorIndex = 9
Case Is = Rg11.Value: c.Interior.ColorIndex = 10
Case Is = Rg12.Value: c.Interior.ColorIndex = 15
Case Is = Rg13.Value: c.Interior.ColorIndex = 8
Case Else: c.Interior.ColorIndex = xlNone
End Select
Next
End If
Set Rg = Nothing: Set c = Nothing
End Sub



Salutations!

--
("|`-''-/").___..--''"`-._
`6_ 6 ) `-. ( ).`-.__.`)
(_Y_.)' ._ ) `._ `. ``-..-'
_..`--'_..-_/ /--'_.' ,'
(il),-'' (li),' ((!.-'




--
Cordialement,

Michel Gaboly
http://www.gaboly.com





--
Cordialement,

Michel Gaboly
http://www.gaboly.com




Avatar
Philippe.R
Juste une pointe d'ironie, sans méchanceté sois en assuré.
Pour Saulieu, malheureusement, je ne pense pas pouvoir m'y rendre, avec bien des regrets.
--
Amicales Salutations

"Michel Gaboly" a écrit dans le message de
news:
Bonjour Philippe

On se moque, je le sesn bien ;-)))

À bientôt à Seaulieu ?



Bonjour Michel,
Merci pour ce cours !
Ah ! si tu n'étais là, dans quel abîme d'ignorance ne sombrerions nous pas !
;o))))))
--
Amicales Salutations

"Michel Gaboly" a écrit dans le message de
news:
Salut Philippe,

Il y a pourtant de nombreuses remarques à faire sur son code.
Ceci dit, s'il est débutant, c'est parfaitement normal ;-)))

1 - Le code associé à un événement de feuille doit être dans le
module de la feuille. Il est donc inutile de qualifier un objet
Range de la feuille avec le nom de celle-ci ; 3 inconvénients :

- Plus long à écrire
- Moins lisible
- Et surtout, cesse de fonctionner si la feuille est renommée.

2 - Si on déclare les variables avec Dim, il faut le faire pour toutes
et pas seulement pour Cell et Rg. Pour cela, il vaut mieux dans les
préférences de VBA, cocher "Déclaration explicite des variables"
(onglet éditeur).

3 - Pour tester une égalité, Case Toto est + simple et + lisible
que Case Is = Toto.

4 - Le For Each c In Target doit être remplacé par

For Each c In Intersect(Target, Range("C6:AG35"))

sous peine de colorier des cellules qui n'appartiennent pas à
la plage C6:AG35 si l'intersection entre cette plage et Target
n'est pas vide (cf. mon message de dimanche dernier à 10h38
heure de Paris), en réponse à ChrisV.

5 - Lorsque comme ici, un même schéma se répète, il faut essayer
de remplacer les lignes successives qui se ressemblent par une
boucle. On y arrive aisément ici, car les cellules constituant Rg à
Rg13 sont contigües, ce qui permet l'emploi d'un Offset et l'économie
de ces 13 variables objet, en utilisant un Array pour les valeurs à
utiliser pour ColorIndex :

Private Sub Worksheet_Change(ByVal Target As Excel.Range)
Dim c As Range, Mat, i As Integer
Mat = Array(21, 33, 30, 42, 2, 37, 38, 3, 6, 9, 10, 15, 8)
If Not Intersect(Target, Range("C6:AG35")) Is Nothing Then
' MEFC
For Each c In Intersect(Target, Range("C6:AG35"))
For i = 0 To 12
If c = Range("B4").Offset(0, i) Then
c.Interior.ColorIndex = Mat(i)
Exit For
Else
c.Interior.ColorIndex = xlNone
End If
Next i
Next c
End If
End Sub




Bonjour Jacquouille Le Gaulois,
Qu'est ce qui ne fonctionne pas dans ton code ?
Peux tu préciser un t'it peu s'il te plait ?
A tout hasard, cette version convient elle mieux ?

Private Sub Worksheet_change(ByVal Target As Range)
Dim c As Range
Dim Rg As Range

Set Rg = Worksheets("Feuil2").Range("B4")
Set Rg2 = Worksheets("Feuil2").Range("C4")
Set Rg3 = Worksheets("Feuil2").Range("D4")
Set Rg4 = Worksheets("Feuil2").Range("E4")
Set Rg5 = Worksheets("Feuil2").Range("F4")
Set Rg6 = Worksheets("Feuil2").Range("G4")
Set Rg7 = Worksheets("Feuil2").Range("H4")
Set Rg8 = Worksheets("Feuil2").Range("I4")
Set Rg9 = Worksheets("Feuil2").Range("J4")
Set Rg10 = Worksheets("Feuil2").Range("K4")
Set Rg11 = Worksheets("Feuil2").Range("L4")
Set Rg12 = Worksheets("Feuil2").Range("M4")
Set Rg13 = Worksheets("Feuil2").Range("N4")

If Not Intersect(Target, Range("C6:AG35")) Is Nothing Then
For Each c In Target
Select Case c.Value
Case Is = Rg.Value: c.Interior.ColorIndex = 21
Case Is = Rg2.Value: c.Interior.ColorIndex = 33
Case Is = Rg3.Value: c.Interior.ColorIndex = 30
Case Is = Rg4.Value: c.Interior.ColorIndex = 42
Case Is = Rg5.Value: c.Interior.ColorIndex = 2
Case Is = Rg6.Value: c.Interior.ColorIndex = 37
Case Is = Rg7.Value: c.Interior.ColorIndex = 38
Case Is = Rg8.Value: c.Interior.ColorIndex = 3
Case Is = Rg9.Value: c.Interior.ColorIndex = 6
Case Is = Rg10.Value: c.Interior.ColorIndex = 9
Case Is = Rg11.Value: c.Interior.ColorIndex = 10
Case Is = Rg12.Value: c.Interior.ColorIndex = 15
Case Is = Rg13.Value: c.Interior.ColorIndex = 8
Case Else: c.Interior.ColorIndex = xlNone
End Select
Next
Else
ActiveCell.Interior.ColorIndex = xlNone
Exit Sub
End If
Calculate
Set Rg = Nothing: Set c = Nothing
End Sub

--
Amicales Salutations

Retirer A_S_ pour répondre.
XL97 / XL2002

"Jacquouille Le Gaulois" a écrit dans le message de
news:
Bonjour,

J'ai essaye de modifier le code envoye par Michdenis et cela ne marche
pas quelqu'un pourrais me dire ce qui cloche
Voici mon code ( de debutant...certainement ) :-Z


Private Sub Worksheet_change(ByVal Target As Range)
Dim c As Range
Dim Rg As Range

Set Rg = Worksheets("Feuil17").Range("B4")
Set Rg2 = Worksheets("Feuil17").Range("C4")
Set Rg3 = Worksheets("Feuil17").Range("D4")
Set Rg4 = Worksheets("Feuil17").Range("E4")
Set Rg5 = Worksheets("Feuil17").Range("F4")
Set Rg6 = Worksheets("Feuil17").Range("G4")
Set Rg7 = Worksheets("Feuil17").Range("H4")
Set Rg8 = Worksheets("Feuil17").Range("I4")
Set Rg9 = Worksheets("Feuil17").Range("J4")
Set Rg10 = Worksheets("Feuil17").Range("K4")
Set Rg11 = Worksheets("Feuil17").Range("L4")
Set Rg12 = Worksheets("Feuil17").Range("M4")
Set Rg13 = Worksheets("Feuil17").Range("N4")


If Not Intersect(Target, Range("C6:AG35")) Is Nothing Then
For Each c In Target
Select Case c.Value
Case Is = Rg.Value: c.Interior.ColorIndex = 21
Case Is = Rg2.Value: c.Interior.ColorIndex = 33
Case Is = Rg3.Value: c.Interior.ColorIndex = 30
Case Is = Rg4.Value: c.Interior.ColorIndex = 42
Case Is = Rg5.Value: c.Interior.ColorIndex = 2
Case Is = Rg6.Value: c.Interior.ColorIndex = 37
Case Is = Rg7.Value: c.Interior.ColorIndex = 38
Case Is = Rg8.Value: c.Interior.ColorIndex = 3
Case Is = Rg9.Value: c.Interior.ColorIndex = 6
Case Is = Rg10.Value: c.Interior.ColorIndex = 9
Case Is = Rg11.Value: c.Interior.ColorIndex = 10
Case Is = Rg12.Value: c.Interior.ColorIndex = 15
Case Is = Rg13.Value: c.Interior.ColorIndex = 8
Case Else: c.Interior.ColorIndex = xlNone
End Select
Next
End If
Set Rg = Nothing: Set c = Nothing
End Sub



Salutations!

--
("|`-''-/").___..--''"`-._
`6_ 6 ) `-. ( ).`-.__.`)
(_Y_.)' ._ ) `._ `. ``-..-'
_..`--'_..-_/ /--'_.' ,'
(il),-'' (li),' ((!.-'




--
Cordialement,

Michel Gaboly
http://www.gaboly.com





--
Cordialement,

Michel Gaboly
http://www.gaboly.com








Avatar
Michel Gaboly
Dommage pour Seaulieu ;-((( , ce devrait être agréable, surtout en mai.


Juste une pointe d'ironie, sans méchanceté sois en assuré.
Pour Saulieu, malheureusement, je ne pense pas pouvoir m'y rendre, avec bien des regrets.
--
Amicales Salutations

"Michel Gaboly" a écrit dans le message de
news:
Bonjour Philippe

On se moque, je le sens bien ;-)))

À bientôt à Seaulieu ?



Bonjour Michel,
Merci pour ce cours !
Ah ! si tu n'étais là, dans quel abîme d'ignorance ne sombrerions nous pas !
;o))))))
--
Amicales Salutations

"Michel Gaboly" a écrit dans le message de
news:
Salut Philippe,

Il y a pourtant de nombreuses remarques à faire sur son code.
Ceci dit, s'il est débutant, c'est parfaitement normal ;-)))

1 - Le code associé à un événement de feuille doit être dans le
module de la feuille. Il est donc inutile de qualifier un objet
Range de la feuille avec le nom de celle-ci ; 3 inconvénients :

- Plus long à écrire
- Moins lisible
- Et surtout, cesse de fonctionner si la feuille est renommée.

2 - Si on déclare les variables avec Dim, il faut le faire pour toutes
et pas seulement pour Cell et Rg. Pour cela, il vaut mieux dans les
préférences de VBA, cocher "Déclaration explicite des variables"
(onglet éditeur).

3 - Pour tester une égalité, Case Toto est + simple et + lisible
que Case Is = Toto.

4 - Le For Each c In Target doit être remplacé par

For Each c In Intersect(Target, Range("C6:AG35"))

sous peine de colorier des cellules qui n'appartiennent pas à
la plage C6:AG35 si l'intersection entre cette plage et Target
n'est pas vide (cf. mon message de dimanche dernier à 10h38
heure de Paris), en réponse à ChrisV.

5 - Lorsque comme ici, un même schéma se répète, il faut essayer
de remplacer les lignes successives qui se ressemblent par une
boucle. On y arrive aisément ici, car les cellules constituant Rg à
Rg13 sont contigües, ce qui permet l'emploi d'un Offset et l'économie
de ces 13 variables objet, en utilisant un Array pour les valeurs à
utiliser pour ColorIndex :

Private Sub Worksheet_Change(ByVal Target As Excel.Range)
Dim c As Range, Mat, i As Integer
Mat = Array(21, 33, 30, 42, 2, 37, 38, 3, 6, 9, 10, 15, 8)
If Not Intersect(Target, Range("C6:AG35")) Is Nothing Then
' MEFC
For Each c In Intersect(Target, Range("C6:AG35"))
For i = 0 To 12
If c = Range("B4").Offset(0, i) Then
c.Interior.ColorIndex = Mat(i)
Exit For
Else
c.Interior.ColorIndex = xlNone
End If
Next i
Next c
End If
End Sub




Bonjour Jacquouille Le Gaulois,
Qu'est ce qui ne fonctionne pas dans ton code ?
Peux tu préciser un t'it peu s'il te plait ?
A tout hasard, cette version convient elle mieux ?

Private Sub Worksheet_change(ByVal Target As Range)
Dim c As Range
Dim Rg As Range

Set Rg = Worksheets("Feuil2").Range("B4")
Set Rg2 = Worksheets("Feuil2").Range("C4")
Set Rg3 = Worksheets("Feuil2").Range("D4")
Set Rg4 = Worksheets("Feuil2").Range("E4")
Set Rg5 = Worksheets("Feuil2").Range("F4")
Set Rg6 = Worksheets("Feuil2").Range("G4")
Set Rg7 = Worksheets("Feuil2").Range("H4")
Set Rg8 = Worksheets("Feuil2").Range("I4")
Set Rg9 = Worksheets("Feuil2").Range("J4")
Set Rg10 = Worksheets("Feuil2").Range("K4")
Set Rg11 = Worksheets("Feuil2").Range("L4")
Set Rg12 = Worksheets("Feuil2").Range("M4")
Set Rg13 = Worksheets("Feuil2").Range("N4")

If Not Intersect(Target, Range("C6:AG35")) Is Nothing Then
For Each c In Target
Select Case c.Value
Case Is = Rg.Value: c.Interior.ColorIndex = 21
Case Is = Rg2.Value: c.Interior.ColorIndex = 33
Case Is = Rg3.Value: c.Interior.ColorIndex = 30
Case Is = Rg4.Value: c.Interior.ColorIndex = 42
Case Is = Rg5.Value: c.Interior.ColorIndex = 2
Case Is = Rg6.Value: c.Interior.ColorIndex = 37
Case Is = Rg7.Value: c.Interior.ColorIndex = 38
Case Is = Rg8.Value: c.Interior.ColorIndex = 3
Case Is = Rg9.Value: c.Interior.ColorIndex = 6
Case Is = Rg10.Value: c.Interior.ColorIndex = 9
Case Is = Rg11.Value: c.Interior.ColorIndex = 10
Case Is = Rg12.Value: c.Interior.ColorIndex = 15
Case Is = Rg13.Value: c.Interior.ColorIndex = 8
Case Else: c.Interior.ColorIndex = xlNone
End Select
Next
Else
ActiveCell.Interior.ColorIndex = xlNone
Exit Sub
End If
Calculate
Set Rg = Nothing: Set c = Nothing
End Sub

--
Amicales Salutations

Retirer A_S_ pour répondre.
XL97 / XL2002

"Jacquouille Le Gaulois" a écrit dans le message de
news:
Bonjour,

J'ai essaye de modifier le code envoye par Michdenis et cela ne marche
pas quelqu'un pourrais me dire ce qui cloche
Voici mon code ( de debutant...certainement ) :-Z


Private Sub Worksheet_change(ByVal Target As Range)
Dim c As Range
Dim Rg As Range

Set Rg = Worksheets("Feuil17").Range("B4")
Set Rg2 = Worksheets("Feuil17").Range("C4")
Set Rg3 = Worksheets("Feuil17").Range("D4")
Set Rg4 = Worksheets("Feuil17").Range("E4")
Set Rg5 = Worksheets("Feuil17").Range("F4")
Set Rg6 = Worksheets("Feuil17").Range("G4")
Set Rg7 = Worksheets("Feuil17").Range("H4")
Set Rg8 = Worksheets("Feuil17").Range("I4")
Set Rg9 = Worksheets("Feuil17").Range("J4")
Set Rg10 = Worksheets("Feuil17").Range("K4")
Set Rg11 = Worksheets("Feuil17").Range("L4")
Set Rg12 = Worksheets("Feuil17").Range("M4")
Set Rg13 = Worksheets("Feuil17").Range("N4")


If Not Intersect(Target, Range("C6:AG35")) Is Nothing Then
For Each c In Target
Select Case c.Value
Case Is = Rg.Value: c.Interior.ColorIndex = 21
Case Is = Rg2.Value: c.Interior.ColorIndex = 33
Case Is = Rg3.Value: c.Interior.ColorIndex = 30
Case Is = Rg4.Value: c.Interior.ColorIndex = 42
Case Is = Rg5.Value: c.Interior.ColorIndex = 2
Case Is = Rg6.Value: c.Interior.ColorIndex = 37
Case Is = Rg7.Value: c.Interior.ColorIndex = 38
Case Is = Rg8.Value: c.Interior.ColorIndex = 3
Case Is = Rg9.Value: c.Interior.ColorIndex = 6
Case Is = Rg10.Value: c.Interior.ColorIndex = 9
Case Is = Rg11.Value: c.Interior.ColorIndex = 10
Case Is = Rg12.Value: c.Interior.ColorIndex = 15
Case Is = Rg13.Value: c.Interior.ColorIndex = 8
Case Else: c.Interior.ColorIndex = xlNone
End Select
Next
End If
Set Rg = Nothing: Set c = Nothing
End Sub



Salutations!

--
("|`-''-/").___..--''"`-._
`6_ 6 ) `-. ( ).`-.__.`)
(_Y_.)' ._ ) `._ `. ``-..-'
_..`--'_..-_/ /--'_.' ,'
(il),-'' (li),' ((!.-'




--
Cordialement,

Michel Gaboly
http://www.gaboly.com





--
Cordialement,

Michel Gaboly
http://www.gaboly.com





--
Cordialement,

Michel Gaboly
http://www.gaboly.com






1 2