Logo GNT
Actualités Tests & Guides Bons Plans
Twitter iPhone pliant OnePlus 11 PS5 Disney+ Orange Livebox Windows 11
Entraide Applications Microsoft Office Excel Utilisation du code Private Sub Worksheet_Change sur plusieurs feuilles

Utilisation du code Private Sub Worksheet_Change sur plusieurs feuilles

2 réponses
Avatar
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
Signaler un problème avec ce contenu

2 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
Avatar
MichDenis
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
'----------------------------------------------------
Avatar
captain-kirk
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)