Problème Private Sub Worksheet_Selection Change
Bonjour à tous
Je suis en train de réaliser un tableau de bord social dans le cadre d'un stage.J'ai un tableau qui est une base de données des salariés
- La colonne E donne des informations sur le sexe de la personne : Homme ou Femme ( elle s'étend de E6 à E227)
- La colonne H donne des informations sur la catégorie socioprofessionnelle du salarié (Ouvrier, Employé, Agent de maîtrise, Cadre) (H6 à H227)
- La colonne K contient les salaires. Je voudrais mettre une couleur en fonction du sexe de la personne (bleu clair pour les hommes ou rose pour les femmes). (K6 à K227)
- La colonne L contient exactement les mêmes salaires. Mais cette fois-ci, je voudrais mettre une couleur en fonction de la catégorie socioprofessionnelle auquelle appartient le salairé. (L6 à L227)
J'a intégré le code suivant pour colorier les cellules en fonction du sexe de la personne et de la catégorie socioprofessionnelle
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: Exit Sub
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
End Sub
Ensuite, j'ai inséré dans un module une fonction qui permet de faire la somme des valeurs contenues dans les cellules en fonction de leurs couleurs de fonds:
Function SommeCouleurFond(champ As Range, couleurFond)
Application.Volatile
Dim c, temp
temp = 0
For Each c In champ
If c.Interior.ColorIndex = couleurFond Then
If IsNumeric(c.Value) Then temp = temp + c.Value
End If
Next c
SommeCouleurFond = temp
End Function
Jusque là aucun problème. Mais cette fonction est loin d'être parfaite. Quand les valeurs des cellules colorées changent, cette fonction recalcule automatiquement le résultat. Mais quand on change la couleur de fond de la cellule, rien ne se passe. Pour remedier au problème, il faut insérer le code suivant :
Dim celluleAvant
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Not IsEmpty(celluleAvant) Then
If Not Intersect(Range(celluleAvant), [plage]) Is Nothing Then Calculate
End If
celluleAvant = Target.Address
End Sub
Mais je me retrouve face à un problème : il n'est pas possible d'avoir deux Worksheet_SelectionChange dans la même feuille.
Je suis un novice (je ne savais pas ce qu'était une macro il y a une semaine) alors merci de m'aider. Comment résoudre ce problème? Peut-on faire une macro à la place? Et si oui, laquelle?
Merci
Bonjour,
dans le code que tu viens de donner, je ne vois qu'un seul Selection_Change?????
PS, pour insérer du code, tu cliques sur le bouton Code, tu colles ton code, et tu recliques sur le bouton Code, pour fermer la balise...
Excuse moi mais je comprends pas trop ce que tu veux dire. Je sais pas comment faire.
Dans le premier code, j'ai utlisé un Worksheet_Change pour colorier mes cellules en fonction de certains critères. Pour le deuxième code, il s'agit d'un Worksheet_SelectionChange
Ce n'est pas la même chose vu qu'il y a un Change? En tout cas, ça ne marche pas. Voilà ce que ça donne:
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: Exit Sub
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
End Sub
Dim celluleAvant
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Not IsEmpty(celluleAvant) Then
If Not Intersect(Range(celluleAvant), [E6:E227]) Is Nothing Then Calculate
End If
celluleAvant = Target.Address
Quand je change la couleur de fond d'une cellule (qui normalement devrait recalculer automatiquement le résultat), L'ordinateur me marque "Erreur de compilation: Seuls des commentaires peuvent apparaître après End Sub, End Function ou End Property
End Sub
Re-,
ce n'est pas gênant du tout, bien au contraire
Selection_Change et Change sont 2 évènements bien distincts....
Par contre, ton Dim celluleAvant, il se trouve où?
Entre les 2 procédures?
Tu peux le mettre à l'intérieur du Selection_Change
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim celluleAvant
If Not IsEmpty(celluleAvant) Then
If Not Intersect(Range(celluleAvant), [plage]) Is Nothing Then Calculate
End If
celluleAvant = Target.Address
End SubEt tu ne fais pas beaucoup d'efforts, pour suivre les conseils (utilisation de la balise Code...)
OK merci beaucoup
(et désolé pour la balise mais je n'utilise pas souvent les forums)