Utilisation du code Private Sub Worksheet_Change sur plusieurs feuilles

Le
captain-kirk
Bonjour à tous.


J'ai utilisé le code suivant pour colorier des cellules d'une base de données que j'ai créé en fonction de certains critères.
-Private Sub Worksheet_Change(ByVal Target As Range)
Dim lig As Byte, plage As Range
If Intersect(Target, Range("E6:E227")) Is Nothing Then: GoTo Suite

lig = Target.Row
Set plage = Range(Cells(lig, 11), Cells(lig, 11))

Select Case Target
Case Is = "Homme"
plage.Interior.ColorIndex = 41
Case Is = "Femme"
plage.Interior.ColorIndex = 38

Case Else
plage.Interior.ColorIndex = -4142 ' enlève la couleur
End Select

Set plage = Nothing
Suite:
If Intersect(Target, Range("H6:H227")) Is Nothing Then: GoTo Suite2

lig = Target.Row
Set plage = Range(Cells(lig, 12), Cells(lig, 12))

Select Case Target
Case Is = "Ouvrier"
plage.Interior.ColorIndex = 6
Case Is = "Cadre"
plage.Interior.ColorIndex = 3
Case Is = "Employé"
plage.Interior.ColorIndex = 4
Case Is = "Agent de maîtrise"
plage.Interior.ColorIndex = 8

Case Else
plage.Interior.ColorIndex = -4142 ' enlève la couleur
End Select

Set plage = Nothing

Suite2:
If Intersect(Target, Range("E6:E227")) Is Nothing Then: GoTo Suite3
lig = Target.Row
Set plage = Range(Cells(lig, 14), Cells(lig, 14))

Select Case Target
Case Is = "Homme"
plage.Interior.ColorIndex = 41
Case Is = "Femme"
plage.Interior.ColorIndex = 38

Case Else
plage.Interior.ColorIndex = -4142 ' enlève la couleur
End Select

Set plage = Nothing

Suite3:
If Intersect(Target, Range("H6:H227")) Is Nothing Then: Exit Sub

lig = Target.Row
Set plage = Range(Cells(lig, 15), Cells(lig, 15))

Select Case Target
Case Is = "Ouvrier"
plage.Interior.ColorIndex = 6
Case Is = "Cadre"
plage.Interior.ColorIndex = 3
Case Is = "Employé"
plage.Interior.ColorIndex = 4
Case Is = "Agent de maîtrise"
plage.Interior.ColorIndex = 8

Case Else
plage.Interior.ColorIndex = -4142 ' enlève la couleur
End Select

Set plage = Nothing

End Sub
-
Ce code marche à merveille mais s'applique uniquement à la première feuille de mon classeur. Mon classeur possède 19 feuilles et je voudrais que ce code s'applique aux 12 premières feuilles. J'ai donc recopié le code ci-dessus dans la feuille 2 pour tester mais aucun résultat. Rien ne se passe. Les cellules ne se mettent pas en couleur.

Comment résoudre ce problème? Peut-on utiliser le même code sur plusieurs feuilles différentes?

Merci
Vidéos High-Tech et Jeu Vidéo
Téléchargements
Vos réponses
Gagnez chaque mois un abonnement Premium avec GNT : Inscrivez-vous !
Trier par : date / pertinence
MichDenis
Le #19815581
Bonjour Capitaine,

copie cette procédure dans le ThisWorkbook de ton projet VBA

Dans la procédure, tu dois définir le nom de toutes les feuilles
où la procédure doit s'exécuter.
N.B - Attention aux coupures de lignes intempestives du service de messagerie !

'-------------------------------------
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)

Dim lig As Byte, plage As Range
Select Case Sh.Name
'inscrit le nom des onglets de tes feuilles
'où la procédure doit s'exécuter
Case Is = "Feuil1", "Feuil3"
If Intersect(Target, Range("E6:E227")) Is Nothing Then: GoTo Suite
lig = Target.Row
Set plage = Range(Cells(lig, 11), Cells(lig, 11))

Select Case Target
Case Is = "Homme"
plage.Interior.ColorIndex = 41
Case Is = "Femme"
plage.Interior.ColorIndex = 38

Case Else
plage.Interior.ColorIndex = -4142 ' enlève la couleur
End Select

Set plage = Nothing
Suite:
If Intersect(Target, Range("H6:H227")) Is Nothing Then: GoTo Suite2
lig = Target.Row
Set plage = Range(Cells(lig, 12), Cells(lig, 12))

Select Case Target
Case Is = "Ouvrier"
plage.Interior.ColorIndex = 6
Case Is = "Cadre"
plage.Interior.ColorIndex = 3
Case Is = "Employé"
plage.Interior.ColorIndex = 4
Case Is = "Agent de maîtrise"
plage.Interior.ColorIndex = 8
Case Else
plage.Interior.ColorIndex = -4142 ' enlève la couleur
End Select
Set plage = Nothing

Suite2:
If Intersect(Target, Range("E6:E227")) Is Nothing Then: GoTo Suite3
lig = Target.Row
Set plage = Range(Cells(lig, 14), Cells(lig, 14))

Select Case Target
Case Is = "Homme"
plage.Interior.ColorIndex = 41
Case Is = "Femme"
plage.Interior.ColorIndex = 38
Case Else
plage.Interior.ColorIndex = -4142 ' enlève la couleur
End Select
Set plage = Nothing

Suite3:
If Intersect(Target, Range("H6:H227")) Is Nothing Then: Exit Sub
lig = Target.Row
Set plage = Range(Cells(lig, 15), Cells(lig, 15))

Select Case Target
Case Is = "Ouvrier"
plage.Interior.ColorIndex = 6
Case Is = "Cadre"
plage.Interior.ColorIndex = 3
Case Is = "Employé"
plage.Interior.ColorIndex = 4
Case Is = "Agent de maîtrise"
plage.Interior.ColorIndex = 8
Case Else
plage.Interior.ColorIndex = -4142 ' enlève la couleur
End Select
Set plage = Nothing
End Select
End Sub
'----------------------------------------------------
captain-kirk
Le #19820251
MichDenis a écrit le 23/07/2009 à 16h38 :
Bonjour Capitaine,

copie cette procédure dans le ThisWorkbook de ton projet VBA

Dans la procédure, tu dois définir le nom de toutes les feuilles
où la procédure doit s'exécuter.
N.B - Attention aux coupures de lignes intempestives du service de messagerie !

'-------------------------------------
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)

Dim lig As Byte, plage As Range
Select Case Sh.Name
'inscrit le nom des onglets de tes feuilles
'où la procédure doit s'exécuter
Case Is = "Feuil1", "Feuil3"
If Intersect(Target, Range("E6:E227")) Is Nothing Then: GoTo Suite
lig = Target.Row
Set plage = Range(Cells(lig, 11), Cells(lig, 11))

Select Case Target
Case Is = "Homme"
plage.Interior.ColorIndex = 41
Case Is = "Femme"
plage.Interior.ColorIndex = 38

Case Else
plage.Interior.ColorIndex = -4142 ' enlève la couleur
End Select

Set plage = Nothing
Suite:
If Intersect(Target, Range("H6:H227")) Is Nothing Then: GoTo Suite2
lig = Target.Row
Set plage = Range(Cells(lig, 12), Cells(lig, 12))

Select Case Target
Case Is = "Ouvrier"
plage.Interior.ColorIndex = 6
Case Is = "Cadre"
plage.Interior.ColorIndex = 3
Case Is = "Employé"
plage.Interior.ColorIndex = 4
Case Is = "Agent de maîtrise"
plage.Interior.ColorIndex = 8
Case Else
plage.Interior.ColorIndex = -4142 ' enlève la couleur
End Select
Set plage = Nothing

Suite2:
If Intersect(Target, Range("E6:E227")) Is Nothing Then: GoTo Suite3
lig = Target.Row
Set plage = Range(Cells(lig, 14), Cells(lig, 14))

Select Case Target
Case Is = "Homme"
plage.Interior.ColorIndex = 41
Case Is = "Femme"
plage.Interior.ColorIndex = 38
Case Else
plage.Interior.ColorIndex = -4142 ' enlève la couleur
End Select
Set plage = Nothing

Suite3:
If Intersect(Target, Range("H6:H227")) Is Nothing Then: Exit Sub
lig = Target.Row
Set plage = Range(Cells(lig, 15), Cells(lig, 15))

Select Case Target
Case Is = "Ouvrier"
plage.Interior.ColorIndex = 6
Case Is = "Cadre"
plage.Interior.ColorIndex = 3
Case Is = "Employé"
plage.Interior.ColorIndex = 4
Case Is = "Agent de maîtrise"
plage.Interior.ColorIndex = 8
Case Else
plage.Interior.ColorIndex = -4142 ' enlève la couleur
End Select
Set plage = Nothing
End Select
End Sub
'----------------------------------------------------


Cela fonctionne à merveille. Un grand merci à toi mon ami, tu me sauves la vie (et j'exagère à peine)
Publicité
Poster une réponse
Anonyme