Bug macro couleurs de cellules

[Guy_L]

Bonjour,
afin d'identifier visuellement une répartition sur une feuille de calcul servant de planning, j'ai intégré dans celui-ci une petite macro qui donne aux cellules une couleur déterminée à la fois par la présence de la personne (notifiée sur une feuille "calendrier") et par sa place dans la hiérarchie (execution, maîtrise, cadre, cadre sup).
Sur la feuille calendrier, un bouton de cde permet de lancer la macro "voir planning" qui a pour but de "rafraîchir" la feuille planning en "balayant les cellules" de façon à effectuer les calculs nécessaires.
Or, que ce soit manuellement ou via cette macro, un bug indiquant une incompatibilité (erreur d'execution '13' : incompatibilité de type) pointe sur la ligne Case Is = "". Si je la mets en remarque (') c'est sur la suivante ( Case Is < "300") que pointe le bug.

J'utilise Excel 2000

Quelqu'un pourrait-il me renseigner ?
D'avance merci. Ci joint la macro intégrée permettant de donner des couleurs aux cellules, puis la macro lançant le rafraîchissement de planning à partir de la feuille calendrier.

Private Sub Worksheet_Change(ByVal Target As Range)

Dim c As Range
For Each c In Range("E6:CC79")

Select Case c.Value
Case Is = ""
c.Interior.ColorIndex = 2
Case Is < "300"
c.Interior.ColorIndex = 3
'collège execution
Case Is = "300"
c.Interior.ColorIndex = 35
Case Is = "301"
c.Interior.ColorIndex = 35
Case Is = "302"
c.Interior.ColorIndex = 35
Case Is = "320"
c.Interior.ColorIndex = 4
Case Is = "321"
c.Interior.ColorIndex = 4
Case Is = "322"
c.Interior.ColorIndex = 4
Case Is = "340"
c.Interior.ColorIndex = 35
Case Is = "341"
c.Interior.ColorIndex = 35
Case Is = "342"
c.Interior.ColorIndex = 35
Case Is = "360"
c.Interior.ColorIndex = 35
Case Is = "361"
c.Interior.ColorIndex = 35
Case Is = "362"
c.Interior.ColorIndex = 35
Case Is = "380"
c.Interior.ColorIndex = 35
Case Is = "381"
c.Interior.ColorIndex = 35
Case Is = "382"
c.Interior.ColorIndex = 35
Case Is = "400"
c.Interior.ColorIndex = 4
Case Is = "401"
c.Interior.ColorIndex = 4
Case Is = "402"
c.Interior.ColorIndex = 4
Case Is = "420"
c.Interior.ColorIndex = 4
Case Is = "421"
c.Interior.ColorIndex = 4
Case Is = "422"
c.Interior.ColorIndex = 4
Case Is = "440"
c.Interior.ColorIndex = 4
Case Is = "441"
c.Interior.ColorIndex = 4
Case Is = "442"
c.Interior.ColorIndex = 4
Case Is = "460"
c.Interior.ColorIndex = 35
Case Is = "461"
c.Interior.ColorIndex = 35
Case Is = "462"
c.Interior.ColorIndex = 35
Case Is = "480"
c.Interior.ColorIndex = 35
Case Is = "481"
c.Interior.ColorIndex = 35
Case Is = "482"
c.Interior.ColorIndex = 35
Case Is = "500"
c.Interior.ColorIndex = 4
Case Is = "501"
c.Interior.ColorIndex = 4
Case Is = "502"
c.Interior.ColorIndex = 4
Case Is = "520"
c.Interior.ColorIndex = 4
Case Is = "521"
c.Interior.ColorIndex = 4
Case Is = "522"
c.Interior.ColorIndex = 4
'collège maîtrise
Case Is = "304"
c.Interior.ColorIndex = 36
Case Is = "305"
c.Interior.ColorIndex = 36
Case Is = "324"
c.Interior.ColorIndex = 6
Case Is = "325"
c.Interior.ColorIndex = 6
Case Is = "344"
c.Interior.ColorIndex = 36
Case Is = "345"
c.Interior.ColorIndex = 36
Case Is = "364"
c.Interior.ColorIndex = 36
Case Is = "365"
c.Interior.ColorIndex = 36
Case Is = "384"
c.Interior.ColorIndex = 36
Case Is = "385"
c.Interior.ColorIndex = 36
Case Is = "404"
c.Interior.ColorIndex = 6
Case Is = "405"
c.Interior.ColorIndex = 6
Case Is = "424"
c.Interior.ColorIndex = 6
Case Is = "425"
c.Interior.ColorIndex = 6
Case Is = "444"
c.Interior.ColorIndex = 6
Case Is = "445"
c.Interior.ColorIndex = 6
Case Is = "464"
c.Interior.ColorIndex = 36
Case Is = "465"
c.Interior.ColorIndex = 36
Case Is = "484"
c.Interior.ColorIndex = 36
Case Is = "485"
c.Interior.ColorIndex = 36
Case Is = "504"
c.Interior.ColorIndex = 6
Case Is = "505"
c.Interior.ColorIndex = 6
Case Is = "524"
c.Interior.ColorIndex = 6
Case Is = "525"
c.Interior.ColorIndex = 6
'collège cadres
Case Is = "306"
c.Interior.ColorIndex = 2
Case Is = "307"
c.Interior.ColorIndex = 2
Case Is = "326"
c.Interior.ColorIndex = 6
Case Is = "327"
c.Interior.ColorIndex = 6
Case Is = "346"
c.Interior.ColorIndex = 2
Case Is = "347"
c.Interior.ColorIndex = 2
Case Is = "366"
c.Interior.ColorIndex = 2
Case Is = "367"
c.Interior.ColorIndex = 2
Case Is = "386"
c.Interior.ColorIndex = 2
Case Is = "387"
c.Interior.ColorIndex = 2
Case Is = "406"
c.Interior.ColorIndex = 6
Case Is = "407"
c.Interior.ColorIndex = 6
Case Is = "426"
c.Interior.ColorIndex = 6
Case Is = "427"
c.Interior.ColorIndex = 6
Case Is = "446"
c.Interior.ColorIndex = 6
Case Is = "447"
c.Interior.ColorIndex = 6
Case Is = "466"
c.Interior.ColorIndex = 2
Case Is = "467"
c.Interior.ColorIndex = 2
Case Is = "486"
c.Interior.ColorIndex = 2
Case Is = "487"
c.Interior.ColorIndex = 2
Case Is = "506"
c.Interior.ColorIndex = 6
Case Is = "507"
c.Interior.ColorIndex = 6
Case Is = "526"
c.Interior.ColorIndex = 6
Case Is = "527"
c.Interior.ColorIndex = 6
'collège cadres supérieurs
Case Is = "308"
c.Interior.ColorIndex = 2
Case Is = "309"
c.Interior.ColorIndex = 2
Case Is = "310"
c.Interior.ColorIndex = 2
Case Is = "328"
c.Interior.ColorIndex = 15
Case Is = "329"
c.Interior.ColorIndex = 15
Case Is = "330"
c.Interior.ColorIndex = 15
Case Is = "348"
c.Interior.ColorIndex = 2
Case Is = "349"
c.Interior.ColorIndex = 2
Case Is = "350"
c.Interior.ColorIndex = 2
Case Is = "368"
c.Interior.ColorIndex = 2
Case Is = "369"
c.Interior.ColorIndex = 2
Case Is = "370"
c.Interior.ColorIndex = 2
Case Is = "388"
c.Interior.ColorIndex = 2
Case Is = "389"
c.Interior.ColorIndex = 2
Case Is = "390"
c.Interior.ColorIndex = 2
Case Is = "408"
c.Interior.ColorIndex = 15
Case Is = "409"
c.Interior.ColorIndex = 15
Case Is = "410"
c.Interior.ColorIndex = 15
Case Is = "428"
c.Interior.ColorIndex = 15
Case Is = "429"
c.Interior.ColorIndex = 15
Case Is = "430"
c.Interior.ColorIndex = 15
Case Is = "448"
c.Interior.ColorIndex = 15
Case Is = "449"
c.Interior.ColorIndex = 15
Case Is = "450"
c.Interior.ColorIndex = 15
Case Is = "468"
c.Interior.ColorIndex = 2
Case Is = "469"
c.Interior.ColorIndex = 2
Case Is = "470"
c.Interior.ColorIndex = 2
Case Is = "488"
c.Interior.ColorIndex = 2
Case Is = "489"
c.Interior.ColorIndex = 2
Case Is = "490"
c.Interior.ColorIndex = 2
Case Is = "508"
c.Interior.ColorIndex = 15
Case Is = "509"
c.Interior.ColorIndex = 15
Case Is = "510"
c.Interior.ColorIndex = 15
Case Is = "528"
c.Interior.ColorIndex = 15
Case Is = "529"
c.Interior.ColorIndex = 15
Case Is = "530"
c.Interior.ColorIndex = 15
End Select
Next
End Sub
-------------------------------------------------------------------------------------------------------------------------------

Sub Voir_Planning()
'
' Voir_Planning Macro

'
Sheets("Planning").Select
Range("E6").Select
ActiveCell.FormulaR1C1 = _
"=IF(Calendrier!RC2<>"""",INDEX(Noms!R3C19:R76C19,MATCH(Calendrier!RC2,Noms!R3C7:R76C7,0))+Calendrier!RC[-2],0)"
Range("A1").Select
End Sub

 

[fanfan38]

Re : Bug macro couleurs de cellules

Bonjour
La macro des couleurs marche sur mon ordi par contre la macro voir_planning fait appel à un autre fichier...

A+ François

 

[skoobi]

Re : Bug macro couleurs de cellules

Bonjour,

essaye en enlevant "Is =" partout.

 

[tototiti2008]

Re : Bug macro couleurs de cellules

Bonjour à tous,

pour info, et pour simplifier l'écriture d'un Select Case :

Case Is = "300"
c.Interior.ColorIndex = 35
Case Is = "301"
c.Interior.ColorIndex = 35
Case Is = "302"
c.Interior.ColorIndex = 35

peut s'écrire :

Case "300", "301", "302"
c.Interior.ColorIndex = 35

ou même

Case "300" to "302"
c.Interior.ColorIndex = 35

 

[Guest]

Re : Bug macro couleurs de cellules

Bonjour Guy, le forum,

Si tu compare des numériques, essaie en écrivant le select case comme suit:
Case 0

c.Interior.ColorIndex = 2
Case Is < 300
Case 300
c.Interior.ColorIndex = 3
case 348 to 350, 368 to 370,388 to 290 ' pour plusieur fourchettes de valeurs ayant le même traitement
Case 401 To 402 'Pour une fourchette de valeur
End Select

J'oubliais, si ce sont des caractère vaut mieux employé ceci en début:

Select Case c.Text


A bientôt

 

[PascalXLD]

Re : Bug macro couleurs de cellules

Bonjour

en plus de tout ce qui vient d'être dit fais attention car à chaque modif de ta feuille tu rebalayes toutes tes cellules

il serait préférable je pense de faire

Private Sub Worksheet_Change(ByVal Target As Range)
Dim c As Range
If Intersect(Target, Range("E6:CC79")) Is Nothing Then Exit Sub
For Each c In Target

 

[Creepy]

Re : Bug macro couleurs de cellules

Bonjour à vous tous,

Pour completer tout cela, et la réponse de tototiti2008, tu peux bien sûr combiner les différente ecriture du case.

Par exemple:

Case 301, 302, 303, 505 to 510

Creepy

 

[tototiti2008]

Re : Bug macro couleurs de cellules

si avec tout ça on a pas été complet, consulte l'aide VBA sur Select Case

 

[Guy_L]

Re : Bug macro couleurs de cellules

eh ben !
j'ai du boulot, en tous cas, merci à tous, je vais tester tout ça et je vous tiens au courant.
Juste pour répondre à l'un des premiers posts, la macro "voir planning" n'est pas indispensable pour que ça plante, car même en faisant un balayage manuel, le plantage se fait aussi
Encore merci, et à bientôt pour les news.
GL

 

[Guy_L]

Re : Bug macro couleurs de cellules

Bonjour à tous, ou plutôt re-bonjour,

Question:

Private Sub Worksheet_Change(ByVal Target As Range)
Dim c As Range
If Intersect(Target, Range("E6:CC79")) Is Nothing Then Exit Sub
For Each c In Target

ces lignes viennent-elles supprimer la ligne : For Each c In Range("E6:CC79") ??

Sinon, j'ai testé en remplaçant les case multiples par une compilation telle que vous me l'avez décrite.

Et… ça marche. Mais en fait le problème venait de la sélection des cellules à rebalayer après l'application des calculs. En effet, une ligne n'était pas renseignée, et le calcul ne pouvait donc pas s'effectuer, d'où l'erreur. Mais vos infos ont grandement simplifié la macro et donc allégé le fichier.

Il reste cependant une question (en dehors de celle posée ci-dessus à PascalXLD). A l'époque où j'ai créé ce fichier, quelqu'un m'avait donné cette macro pour balayer les cellules de la page planning:

Range("E6").Select
ActiveCell.FormulaR1C1 = _
"=IF(Calendrier!RC2<>"""",INDEX(Noms!R3C19:R76C19,MATCH(Calendrier!RC2,Noms!R3C7:R76C7,0))+Calendrier!RC[-2],0)"
Range("A1").Select


et je ne sais plus ce que tout ça veut dire et donc comment la modifier pour l'adapter à mon problème

Pouvez-vous me guider ?

Merci

 

[fanfan38]

Re : Bug macro couleurs de cellules

Bonjour
Non c'est à mettre avant.


A+ François

 

[PascalXLD]

Re : Bug macro couleurs de cellules

RE

alors oui

If Intersect(Target, Range("E6:CC79")) Is Nothing Then Exit Sub
For Each c In Target

remplace la ligne

For Each c In Range("E6:CC79")

Le principe est le suivant

tu verifies que la cellule venant d'être changée appartient à ta plage
tu n'appliques la macro qu'à la cellule venant d'être changée

D'un autre coté si tes autres cellules dépendent toutes les unes des autres tu es obligé de faire ton code comme tu l'avais écrit

 

[Guy_L]

Re : Bug macro couleurs de cellules

OK, visiblement vos conseils ont servi en bien mon fichier désormais plus efficace

Merci beaucoup à tous