Ceci est une page optimisée pour les mobiles. Cliquez sur ce texte pour afficher la vraie page.

VBA dans excel

P

Prisma

Guest
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...
 
K

keata

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

Pièces jointes

  • PaletteCouleur.xls
    26 KB · Affichages: 51
  • PaletteCouleur.xls
    26 KB · Affichages: 49
  • PaletteCouleur.xls
    26 KB · Affichages: 50
K

keata

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

Keata
 

Pièces jointes

  • PaletteCouleur.xls
    29.5 KB · Affichages: 47
  • PaletteCouleur.xls
    29.5 KB · Affichages: 43
  • PaletteCouleur.xls
    29.5 KB · Affichages: 46
K

keata

Guest
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?
 
G

GM

Guest
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
 
P

Prisma

Guest
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...
 

Discussions similaires

Les cookies sont requis pour utiliser ce site. Vous devez les accepter pour continuer à utiliser le site. En savoir plus…