XL 2010 Créer une feuille excel pour colorier des mots précis

[arvin]

bonjour à tous
grâce au forum, j'ai modifié cette macro qui colorie les noms qui figurent sur une feuille active
mais cela fait beaucoup de noms.............serait il possible de créer une feuille où je n'aurai qu'à rajouter les noms que je souhaite ?

merci à tous

Property Let couleurderemplissage(lacellule As Range)
Dim indexcouleur As Integer
Select Case lacellule.Value

Case "TOTO1 "
indexcouleur = 19
Case "Marc "
indexcouleur = 19
Case "René "
indexcouleur = 19

'c'est long........surtout si il y a 20 noms différents

Case Else
indexcouleur = xlColorIndexNone

End Select
lacellule.Interior.ColorIndex = indexcouleur
End Property

 

[vgendron]

Bonjour

Je ne comprend pas comment fonctionne ton code..
comment un mot est il coloré par ce que tu as écrit??
à quel moment la property que tu as définie est appliquée sur un mot écrit?
pour ta liste de noms, tu peux sans doute définir une liste nommée (Gestionnaire de noms)
dans une feuille que tu appelles "Liste Nom"
tu définis une zone nommée
ListeNoms=DECALER('Liste Nom'!$A$1;;;NBVAL('Liste Nom'!$A:$A))

ensuite tu parcours chaque élément de cette liste pour savoir quelle est la couleur à appliquer: ta liste de nom étant colorée avec les couleurs souhaitées...

 

[vgendron]

essai en PJ

 

[arvin]

merci beaucoup : ça marche nickel
effectivement tu avais raison , j'avais oublié d'inclure la macro dans mon message
un grand merci

Sub verification_noms()
'ActiveSheet.Unprotect
Range("D16:E20,D22:E34,D36:E50,D52:E53,D55:E58,J11:K26,J28:K39,J41:K45,J47:K56,J58:k67").Select
Range("d20").Activate
Dim lacellule As Range
For Each lacellule In Selection
couleurderemplissage = lacellule
Next lacellule
Range("d20:d20").Select
Range("d20").Activate
'ActiveSheet.Protect
End Sub

 

[arvin]

essai en PJ

mince désolé je souhaiterai associer un bouton macro mais cela ne fonctionne pas
sais tu pourquoi ?
ai bien défini ListeNoms comme tu as dis
j'ai enlevé :
'Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)

'Call ColorerCell(Target)
'End Sub


Sub ColorerCell()
'CellToColor As Range



For Each ele In Sheets("Amenagement").Range("ListeNoms")
If ele = CellToColor Then
CellToColor.Interior.ColorIndex = ele.Interior.ColorIndex
Exit For
End If
Next ele

End Sub

 

[vgendron]

Si tu veux déclencher la coloration par bouton, il faut que tu remplaces (je pense) CellToColor par ActiveCell

 

[arvin]

marche pas...ai testé la déclaration de variable aussi
je cherche je cherche un peu partout
ta solution me convenait bien mais les couleurs restent , ou alors je voudrais les enlever .....

 

[arvin]

dommage , avec l'enregistreur de macro cela aurait pu marcher
Sub Macro2()
'
' Macro2 Macro
'

'
Selection.FormatConditions.Add Type:=xlExpression, Formula1:= _
"=DECALER($A$1;;;NBVAL($A:$A))"
Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
With Selection.FormatConditions(1).Font
.Color = -16776961
.TintAndShade = 0
End With
Selection.FormatConditions(1).StopIfTrue = True
End Sub

 

[arvin]

réussi ! mais je souhaite adapter la macro à la feuille active
je vais relancer le sujet car c'est un autre thème
merci
Sub essai()
Set F1 = Worksheets("edt")
With F1
Set plage = .Range("F1:K10")
End With

For Z = 3 To 33 Step 1

For Each cell In plage
cell.Select
If cell.Value = Cells(Z, 2).Value Then Selection.Interior.Color = F1.Cells(Z, 2).Interior.Color
If cell.Value = Cells(Z, 2).Value Then Selection.Font.Color = F1.Cells(Z, 2).Font.Color
Next
Next Z
End Sub

 

[soan]

Bonjour arvin, vgendron,

tu as écrit : « réussi ! mais je souhaite adapter la macro à la feuille active »

je te propose ce code VBA (non testé) :

Option Explicit

Sub essai()
  Dim cel1 As Range, cel2 As Range, Z As Byte
  Application.ScreenUpdating = 0
  For Z = 3 To 33
    Set cel1 = Cells(Z, 2)
    For Each cel2 In [F1:K10]
      If cel2 = cel1 Then
        cel2.Interior.Color = cel1.Interior.Color
        cel2.Font.Color = cel1.Font.Color
      End If
    Next cel2
  Next Z
End Sub

si tu as plus de 255 lignes, alors pour la ligne Dim, au lieu de Z As Byte
met : Z As Long ou plus simplement : Z&

soan