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

(RESOLU)couleur dans cellule via d'autres cellules

chaelie2015

XLDnaute Accro
Bonjour Forum
Je souhaite afficher une couleur dans les cellules ( de224 au 247) selon le texte affiché dedans.
Dans ces cellules, j’ai une formule.ci dessous le code qui fonctionne parfaitement mais avec ces formules ça marche pas ?
Code:
Private Sub Worksheet_Change(ByVal Target As Range)

   Dim C As Range 'couleurs
If Target.Count > 1 Then Exit Sub

If Not Intersect(Target, [A224:A247,G224:G147]) Is Nothing Then
    For Each C In Sheets(2).Range("couleur")
        If Target.Value = C.Value Then
            Target.Interior.Color = C.Offset(, 1).Interior.Color
        End If
    Next C
End If
End Sub
salutations
 

Pièces jointes

  • charlie couleur.xlsm
    20.6 KB · Affichages: 25
  • charlie couleur.xlsm
    20.6 KB · Affichages: 22
Dernière édition:

st007

XLDnaute Barbatruc
Re : couleur dans cellule via d'autres cellules

Bonjour,
tu colore la cellule target, la cible de ta souris, en fonction de la valeur de la cellule.
pas toutes les cellules de la colonne A qui prendrait une certaine valeur...
 

st007

XLDnaute Barbatruc
Re : couleur dans cellule via d'autres cellules

Pour illustrer,

Tu choisis en ligne 124 et 176 une couleur, la même bien sure.
La ligne 228 à pris le nom de cette couleur, mais ne s'est pas colorée puisqu'elle n'est pas la cible (target) du dernier changement
Double clic dedans et fais entrée, elle va se colorer

d'autre part,
If Not Intersect(Target, [A224:A247]) Is Nothing Then
 

Pièces jointes

  • charlie couleur.xlsm
    20.4 KB · Affichages: 21
  • charlie couleur.xlsm
    20.4 KB · Affichages: 23

chaelie2015

XLDnaute Accro
Re : couleur dans cellule via d'autres cellules

Bonjour ST007
Merci d'avoir répondu, mais je souhaite que la couleur dans les cellules ce change automatiquement sans double clic

MERCI
 
Dernière édition:

st007

XLDnaute Barbatruc
Re : couleur dans cellule via d'autres cellules

Bonsoir,
pardon chaelie, je pensais que tu comprendrais mes remarques et adapterais en conséquences.

si j'ai bien tout compris, .....
 

Pièces jointes

  • charlie couleur (1).xlsm
    20.4 KB · Affichages: 18
  • charlie couleur (1).xlsm
    20.4 KB · Affichages: 16
Dernière édition:

chaelie2015

XLDnaute Accro
Re : couleur dans cellule via d'autres cellules

Bonsoir ST007
J'ai bien compris tes remarques , amis ça n'a pas fonctionné, même pour ce fichier joint
si je sélectionne dans les deux premiers tableaux même couleur normalement je devrai avoir dans le tableau 3 ,la couleur de la cellule selon la couleur saisie ( exemple la 1ere cellule Orange et la 4 eme cellule Grise)
 

Pièces jointes

  • charlie couleur (1).xlsm
    20.4 KB · Affichages: 18
  • charlie couleur (1).xlsm
    20.4 KB · Affichages: 19

st007

XLDnaute Barbatruc
Re : couleur dans cellule via d'autres cellules

Bonne nuit en espérant que ce code te satisfasse
Je m'étais planté, pour supprimer la couleur .....
Code:
Private Sub Worksheet_Change(ByVal Target As Range)

   Dim C As Range, S As Range 'couleurs
If Target.Count > 1 Then Exit Sub

For Each S In Range("A224:A247")
S.Interior.Color = xlNone                           'c'est ici, on efface toutes les couleurs avant de recolorer
For Each C In Sheets(2).Range("couleur")
        If S.Value = C.Value Then
            S.Interior.Color = C.Offset(, 1).Interior.Color
        End If
    Next C
    Next S

End Sub
 

Dranreb

XLDnaute Barbatruc
Re : couleur dans cellule via d'autres cellules

Bonsoir
Si ça vous intéresse, j'ai réussi à faire tourner ça dans un module standard :
VB:
Option Explicit
Private Consignes As New Collection

Function EnColoriant(ByVal NomCouleur As String) As String
Dim Cel As Range
Set Cel = [Couleur].Find(What:=NomCouleur, LookIn:=xlValues, _
   LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
   MatchCase:=False, SearchFormat:=False)
If Cel Is Nothing Then
   EnColoriant = NomCouleur & " ?…"
   Consignes.Add Array(Application.Caller, &HBABABA)
Else
   EnColoriant = NomCouleur
   Consignes.Add Array(Application.Caller, Cel.Offset(, 1).Interior.Color)
   End If
End Function

Sub EffectuerColoriages()
Dim T()
Do While Consignes.Count > 0
   T = Consignes(1)
   T(0).Interior.Color = T(1)
   Consignes.Remove 1: Loop
End Sub
En mettant ça dans une cellule :
Code:
=EnColoriant("Rouge")
celle ci se colore en rouge s'il y a bien "Rouge" dans la table Couleur en non pas "Rouge " avec un blanc à la fin, et si le module de la feuille contenant la cellule porte :
VB:
Private Sub Worksheet_Calculate()
EffectuerColoriages
End Sub
Edit: et si votre Feuil1 en est équipé, en A224, à propager sur 24 lignes et 4 colonnes :
Code:
=SI(A120=A172;EnColoriant(A120);"…!!!")
ça se colore aussi en cas d'égalité.
 
Dernière édition:

Discussions similaires

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