Coloration de cellules

[JFBee]

:sick:Question :
comment faut-il faire pour outrepasser le formatage conditionnel qui ne laisse que trois choix comme possibilités ?
Exemple :
dans un fichier d'horaires, je souhaite :
1. que la frappe 'A' entraine une coloration du fond de la cellule en rouge
2. que 'B' entraine du bleu
3. que 'N' entraine du noir
4. que 'C' provoque un fond jaune
5. etc...
Je vous remercie d'avance de pouvoir m'aider dans la réalisation de ce genre de formatage de cellules.
JFBee

 

[Rénato]

bonsoir JFBee

Une petite macro évenementielle du type :

Private Sub Worksheet_Change(ByVal Target As Range)
Dim c As Range

If Not Intersect(Target, Range('A2:F30')) Is Nothing Then
For Each c In Target
Select Case c.Value
Case Is = ''
Target.Interior.ColorIndex = 0
Case Is = 'B'
Target.Interior.ColorIndex = 5
Case Is = 'A'
Target.Interior.ColorIndex = 3
Case Is = 'N'
Target.Interior.ColorIndex = 1
Case Is = 'C'
Target.Interior.ColorIndex = 6
End Select
Next
End If
End Sub

devrait faire l'affaire.
A noter, j'ai réduit pour l'exemple la plage sur l'intervalle A2:F30
Pour insérer ce code, cliquer bouton droit sur l'onglet de la feuille concernée, cliquer sur 'visualiser le code' puis coller le script sur la fenêtre de droite.

Cordialement

 

[JFBee]

Déjà merci à toi Renato
je vais essayer ce script dans mon fichier d'horaires
@+

 

[Rénato]

re, JFBee

Trois petites améliorations :

- Changement de couleur de police pour la lettre 'N' que l'on ne distingue plus dans les cellules à fond noir.
- Changement de la nature du bleu (passage au cyan) le précédent était un peu trop foncé et gènait la lecture du 'B'
- Saisie indifférente de majuscule ou minuscule possible

Private Sub Worksheet_Change(ByVal Target As Range)
Dim c As Range
If Not Intersect(Target, Range('A2:F30')) Is Nothing Then
For Each c In Target
Select Case UCase(c.Value)
Case Is = ''
Target.Interior.ColorIndex = 0
Case Is = 'B'
Target.Interior.ColorIndex = 8
Case Is = 'A'
Target.Interior.ColorIndex = 3
Case Is = 'N'
Target.Interior.ColorIndex = 1
Target.Font.ColorIndex = 2
Case Is = 'C'
Target.Interior.ColorIndex = 6
End Select
Next
End If
End Sub
Bonne fin de soirée.

 

[JFBee]

Re-merci Renato !
:whistle:

 

[JFBee]

Comme je bosse tôt demain matin :angry: :evil: ,
je plie tout et reviendrai demain après avoir essayé ta deuxième solution.
Sorry pour ce soir :S
Mais un TOUT GRAND MERCI quand même :woohoo:

 

[JFBee]

Cher Renato
Malgré que je me lève demain aux petites heures :angry: ,
je n'ai pu résister à l'envie d'essayer ta macro, que dis-je,
ta SUPER MACRO qui fonctionne admirablement bien.
Ca faisait si longtemps que je cherchais à incorporer cette astuce dans mes horaires que j'en étais venu à désespérer :sick: !!!
Mais grâce à toi, je la tiens cette super astuce !

Encore 1000 merci à toi :side:
Cordialement
JFBee