Logo GNT
Actualités Tests & Guides Bons Plans
Twitter iPhone pliant OnePlus 12 PS5 Orange Livebox ChatGPT Mini PC
Entraide Applications Microsoft Office Excel Colorier des cellules avec une macro et/ou avec Privatesub

Colorier des cellules avec une macro et/ou avec Privatesub

13 réponses
Avatar
captain-kirk
Bonjour à tous


Je suis en train de réaliser un tableau de bord social dans le cadre d'un stage et j'aurai besoin de votre aide concernant le coloriage de cellules à l'aide d'une macro.

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 à E95)
-La colonne H donne des informations sur la catégorie socioprofessionnelle du salarié (Ouvrier, Employé, Agent de maîtrise, Cadre) (H6 à H95)
-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 à K95)
-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 à L95)

J'a intégré le code suivant pour colorier les cellules en fonction du sexe de la personne:


Private Sub Worksheet_Change(ByVal Target As Range)
Dim lig As Byte, plage As Range
If Intersect(Target, Range("E6:E95")) Is Nothing Then: Exit Sub

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
End Sub


Ce code marche super bien. J'ai donc fait exactement le même mais pour les catégories socioprofessionnelles:


Private Sub Worksheet_Change(ByVal Target As Range)
Dim lig As Byte, plage As Range
If Intersect(Target, Range("H6:H95")) 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




Normalement ça devrait marcher mais ça coince quand je veux rentrer les données dans la colonne H car l'ordinateur me marque Erreur de compilation : Nom ambigu détecté : Worksheet_Change



Peut-on mettre deux Private Sub dans une même feuille? Peut-on faire des macros au lieu d'utiliser Private sub. Si oui comment? (car j'y connais pratiquement rien)

Merci
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
LSteph
Allo CapitainKirk,

vous ne pouvez pas téléporter deux Change dans le même CodeModule de
la feuille Enterprise
Veuillez placer vos vaisseaux dans le même Change

LSpoke ;-)

On 21 juil, 10:19, captain-kirk
wrote:
Bonjour à tous

Je suis en train de réaliser un tableau de bord social dans le cadre d' un stage
et j'aurai besoin de votre aide concernant le coloriage de cellules à l 'aide
d'une macro.

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 o u
Femme ( elle s'étend de E6 à E95)
-La colonne H donne des informations sur la catégorie socioprofessionne lle du
salarié (Ouvrier, Employé, Agent de maîtrise, Cadre) (H6 à H95)
-La colonne K contient les salaires. Je voudrais mettre une couleur en fo nction
du sexe de la personne (bleu clair pour les hommes ou rose pour les femme s). (K6
à K95)
-La colonne L contient exactement les mêmes salaires. Mais cette fois-c i, je
voudrais mettre une couleur en fonction de la catégorie socioprofession nelle
auquelle appartient le salairé. (L6 à L95)

J'a intégré le code suivant pour colorier les cellules en fonction du sexe de
la personne:

    Private Sub Worksheet_Change(ByVal Target As Range)
Dim lig As Byte, plage As Range
If Intersect(Target, Range("E6:E95")) Is Nothing Then: Exit Sub

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
End Sub

Ce code marche super bien. J'ai donc fait exactement le même mais pour les
catégories socioprofessionnelles:

Private Sub Worksheet_Change(ByVal Target As Range)
Dim lig As Byte, plage As Range
If Intersect(Target, Range("H6:H95")) 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

Normalement ça devrait marcher mais ça coince quand je veux rentrer l es données
dans la colonne H car l'ordinateur me marque Erreur de compilation : Nom ambigu
détecté : Worksheet_Change

Peut-on mettre deux Private Sub dans une même feuille? Peut-on faire de s macros
au lieu d'utiliser Private sub. Si oui comment? (car j'y connais pratique ment
rien)

Merci


Avatar
FFO
Salut à toi

Tu as du mettre 2 fois Private Sub Worksheet_Change(ByVal Target As Range)
pour traiter les 2 cas
Il faut n'en mettre qu'un et inclure tes 2 codes l'un à la suite de l'autre
pour finir avec un End Sub

Ainsi :

Private Sub Worksheet_Change(ByVal Target As Range)
Dim lig As Byte, plage As Range
If Intersect(Target, Range("E6:E95")) 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:H95")) 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

Celà devrait convenir

Dis moi !!!!!!
Avatar
LSteph
... c'est bien cela que je disais, merci de lui avoir donné le corrigé
mais toi tu avais déjà ton brevet de téléportation, ...

;o)

--
LSpoke
(mieux vaut apprendre à pecher que donner un poisson)


On 21 juil, 11:10, FFO wrote:
Salut à toi

Tu as du mettre 2 fois  Private Sub Worksheet_Change(ByVal Target As Ra nge)
pour traiter les 2 cas
Il faut n'en mettre qu'un et inclure tes 2 codes l'un à la suite de l'a utre
pour finir avec un End Sub

Ainsi :

Private Sub Worksheet_Change(ByVal Target As Range)
Dim lig As Byte, plage As Range
If Intersect(Target, Range("E6:E95")) 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:H95")) 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

Celà devrait convenir

Dis moi !!!!!!


Avatar
FFO
Salut LSteph

Que de distinction dont je n'ais pas conscience

Merci de me le rappeler !!!!
Avatar
captain-kirk
LSteph a écrit le 21/07/2009 à 11h36 :
... c'est bien cela que je disais, merci de lui avoir donné le
corrigé
mais toi tu avais déjà ton brevet de
téléportation, ...

;o)

--
LSpoke
(mieux vaut apprendre à pecher que donner un poisson)


On 21 juil, 11:10, FFO wrote:
Salut à toi

Tu as du mettre 2 fois  Private Sub Worksheet_Change(ByVal Target As Ra
nge)
pour traiter les 2 cas
Il faut n'en mettre qu'un et inclure tes 2 codes l'un à la suite de l'a
utre
pour finir avec un End Sub

Ainsi :

Private Sub Worksheet_Change(ByVal Target As Range)
Dim lig As Byte, plage As Range
If Intersect(Target, Range("E6:E95")) 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:H95")) 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

Celà devrait convenir

Dis moi !!!!!!





Merci à vous mais je crois que je vais devoir céder ma place de Capitaine parce que ça ne marche pas du tout.


Aucune des cellules ne se met en couleur. Pourtant, les codes couleurs sont bons.

Comment peut-on transposer ça en macro?
Avatar
captain-kirk
LSteph a écrit le 21/07/2009 à 11h36 :
... c'est bien cela que je disais, merci de lui avoir donné le
corrigé
mais toi tu avais déjà ton brevet de
téléportation, ...

;o)

--
LSpoke
(mieux vaut apprendre à pecher que donner un poisson)


On 21 juil, 11:10, FFO wrote:
Salut à toi

Tu as du mettre 2 fois  Private Sub Worksheet_Change(ByVal Target As Ra
nge)
pour traiter les 2 cas
Il faut n'en mettre qu'un et inclure tes 2 codes l'un à la suite de l'a
utre
pour finir avec un End Sub

Ainsi :

Private Sub Worksheet_Change(ByVal Target As Range)
Dim lig As Byte, plage As Range
If Intersect(Target, Range("E6:E95")) 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:H95")) 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

Celà devrait convenir

Dis moi !!!!!!





Oubliez ce que j'ai dit tout à l'heure. C'est moi qui ai mal recopié la formule. Tout fonctionne parfaitement. En fait, tout cela est très logique comme dirait mon très cher ami aux oreilles pointus

L'Enterprise va pouvoir de nouveaux partir à l'aventure . Merci de m'avoir fait profité de vos connaissances


Et comme diraient les Vulcains: Longue vie et prospérité.
Avatar
MichDenis
| LSpoke

Est-ce que la série télévisée vient d'arriver en France ?
;-)

Capitaine Kirk.
Avatar
LSteph
Relativement à la dimension temporelle on peut dire cela! Cela ne fait
que quelques années, tout compte fait.

;o))

--
lSteph

On 21 juil, 15:06, "MichDenis" wrote:
| LSpoke

Est-ce que la série télévisée vient d'arriver en France ?
;-)

Capitaine Kirk.


Avatar
captain-kirk
captain-kirk a écrit le 21/07/2009 à 10h19 :
Bonjour à tous


Je suis en train de réaliser un tableau de bord social dans le cadre
d'un stage et j'aurai besoin de votre aide concernant le coloriage de cellules
à l'aide d'une macro.

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 à E95)
-La colonne H donne des informations sur la catégorie
socioprofessionnelle du salarié (Ouvrier, Employé, Agent de
maîtrise, Cadre) (H6 à H95)
-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 à K95)
-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 à L95)

J'a intégré le code suivant pour colorier les cellules en
fonction du sexe de la personne:


Private Sub Worksheet_Change(ByVal Target As Range)
Dim lig As Byte, plage As Range
If Intersect(Target, Range("E6:E95")) Is Nothing Then: Exit Sub

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
End Sub


Ce code marche super bien. J'ai donc fait exactement le même mais pour
les catégories socioprofessionnelles:


Private Sub Worksheet_Change(ByVal Target As Range)
Dim lig As Byte, plage As Range
If Intersect(Target, Range("H6:H95")) 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




Normalement ça devrait marcher mais ça coince quand je veux
rentrer les données dans la colonne H car l'ordinateur me marque Erreur
de compilation : Nom ambigu détecté : Worksheet_Change



Peut-on mettre deux Private Sub dans une même feuille? Peut-on faire des
macros au lieu d'utiliser Private sub. Si oui comment? (car j'y connais
pratiquement rien)

Merci


Excusez-moi mais je suis encore face à un problème. La Private Sub précédente fonctionne très bien.

A partir de ça, 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), [B2:G3]) Is Nothing Then Calculate
End If
celluleAvant = Target.Address
End Sub


Mais je me retrouve face au même problème que tout à l'heure à savoir qu'il n'est pas possible d'avoir deux Worksheet_SelectionChange dans la même feuille.

Comment résoudre le problème? Parce que je n'arrive pas insérer ce code dans ce que j'ai fait tout à l'heure.

Merci
Avatar
LSteph
Bonjour,

Il peut fort bien y avoir à la fois un change et selectionchange ce
sont deux évennements distinctcs

Toutefois je recommande fort peu de vouloir calculer avec les couleurs
car mobiliser ainsi
un évennement qui se déclanche chaque fois que l'on bouge de cellule
est très alourdissant surtout s'il relance chaque fois un calculate.
Par principe pour le calcul utiliser plutôt la condition qui prévaut à
la mise en couleur.



--
lSteph

On 21 juil, 15:30, captain-kirk wrote:
captain-kirk a écrit le 21/07/2009 à 10h19 :



> Bonjour à tous

> Je suis en train de réaliser un tableau de bord social dans le cadre
> d'un stage et j'aurai besoin de votre aide concernant le coloriage de
cellules
> à l'aide d'une macro.

> 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 à E95)
> -La colonne H donne des informations sur la catégorie
> socioprofessionnelle du salarié (Ouvrier, Employé, Agent de
> maîtrise, Cadre) (H6 à H95)
> -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 fem mes).
> (K6 à K95)
> -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 à L95)

> J'a intégré le code suivant pour colorier les cellules en
> fonction du sexe de la personne:

>     Private Sub Worksheet_Change(ByVal Target As Range)
> Dim lig As Byte, plage As Range
> If Intersect(Target, Range("E6:E95")) Is Nothing Then: Exit Sub

> 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 coule ur
> End Select

> Set plage = Nothing
> End Sub

> Ce code marche super bien. J'ai donc fait exactement le même mais pou r
> les catégories socioprofessionnelles:

> Private Sub Worksheet_Change(ByVal Target As Range)
> Dim lig As Byte, plage As Range
> If Intersect(Target, Range("H6:H95")) 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 coule ur
> End Select

> Set plage = Nothing
> End Sub

> Normalement ça devrait marcher mais ça coince quand je veux
> rentrer les données dans la colonne H car l'ordinateur me marque Erre ur
> de compilation : Nom ambigu détecté : Worksheet_Change

> Peut-on mettre deux Private Sub dans une même feuille? Peut-on faire des
> macros au lieu d'utiliser Private sub. Si oui comment? (car j'y connais
> pratiquement rien)

> Merci

Excusez-moi mais je suis encore face à un problème. La Private Sub pr écédente
fonctionne très bien.

A partir de ça, 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 couleu rs 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 parfa ite. 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), [B2:G3]) Is Nothing Then Calculate
  End If
  celluleAvant = Target.Address
End Sub

Mais je me retrouve face au même problème que tout à l'heure à sa voir qu'il
n'est pas possible d'avoir deux Worksheet_SelectionChange dans la même feuille.

Comment résoudre le problème? Parce que je n'arrive pas insérer ce code dans ce
que j'ai fait tout à l'heure.

Merci- Masquer le texte des messages précédents -

- Afficher le texte des messages précédents -


1 2