VBA dans excel

[Prisma]

Bonjour,
Je souhaiterais faire une macro en VBA dans Excel pour faire le travail suivant:
Dans une zone sélectionnée (qui peut bien sur changer) il faut que la machine teste chaque cellule et la mette dans une couleur définie selon le chiffre qui est inscrit dans la cellule en question. Mettre une couleur selon le chiffre passe encore, mais comment lui dire de tester chaque cellule d'une sélection ?????

D'avance un grand merci...

 

[keata]

Bonjour,
tu testes les cellules dans 2 boucles imbriquées
Bonne journée

 

[keata]

Re Bonjour,
j'avais pas lu ta question en entier
voici une réponse pour une selection

Keata

 

[Rolilandon]

salut Keata

Pourquoi n'utilise tu pas For each au lieu de deux boucles imbriquées ?

 

[keata]

salut Rolilandon
parce que j'ai besoin de 2 variables (lignes, colonnes)
Je ne pense pas qu'une seule boucle for each ... next convienne
dis-moi si tu as une autre solution?

 

[GM]

Bonsoir Prisma et à tous

Bon décortique tous ça la solution et peut-être dans les deux procédure "Sub DefinirCommentaire()", et "Sub DefinirRemplissage()"
là pour ton fichier tu as le choix non!


Property Get RenvoyerCommentaire(Cellule As Range) As String
Select Case Cellule.Value
Case Is < 10000
RenvoyerCommentaire = "Très mauvais"
Case 10000 To 20000
RenvoyerCommentaire = "Mauvais"
Case 20001 To 30000
RenvoyerCommentaire = "Correct"
Case 30001 To 40000
RenvoyerCommentaire = "Bon"
Case Is > 40000
RenvoyerCommentaire = "Très bon"
End Select
End Property

Sub DefinirCommentaire()
Dim LaCellule As Range
For Each LaCellule In Selection
LaCellule.AddComment (RenvoyerCommentaire(LaCellule))
Next LaCellule
End Sub

Property Get RenvoyerCommentaire(Cellule) As String
Select Case Cellule.Value
Case Is < 10000
RenvoyerCommentaire = "Très mauvais"
Case 10000 To 20000
RenvoyerCommentaire = "Mauvais"
Case 20001 To 30000
RenvoyerCommentaire = "Correct"
Case 30001 To 40000
RenvoyerCommentaire = "Bon"
Case Is > 40000
RenvoyerCommentaire = "Très bon"
End Select
End Property

Property Let CouleurDeRemplissage(LaCellule As Range)
Dim IndexCouleur As Integer
Select Case LaCellule.Comment.Text
Case "Très mauvais"
IndexCouleur = 3 'Index de la couleur Rouge
Case "Mauvais"
IndexCouleur = 6 'Index de la couleur Jaune
Case "Correct"
IndexCouleur = 5 'Index de la couleur Bleu
Case Else
IndexCouleur = xlColorIndexNone
End Select
LaCellule.Interior.ColorIndex = IndexCouleur
End Property

Sub DefinirRemplissage()
Dim LaCellule As Range
For Each LaCellule In Selection
CouleurDeRemplissage = LaCellule
Next LaCellule
End Sub

Property Let CouleurDeRemplissage(LaCellule As Range)
Dim IndexCouleur As Integer
Select Case LaCellule.Comment.Text
Case "Très mauvais"
IndexCouleur = 3 'Index de la couleur Rouge
Case "Mauvais"
IndexCouleur = 6 'Index de la couleur Jaune
Case "Correct"
IndexCouleur = 5 'Index de la couleur Bleu
Case Else
IndexCouleur = xlColorIndexNone
End Select
LaCellule.Interior.ColorIndex = IndexCouleur
End Property

Gérard

 

[Prisma]

Merci les gars,
J'ai utilisé la solution de Keata modifiée à ma sauce, car si dans la cellule il y a le chiffre 1, ce ne sera pas forcément le code couleur 1.
Mais tout fonctionne parfaitement bien et je vous en remercie infiniment.

Bien à vous...