Couleur auto d'une cellule fonction de la valeur inscrite

Bonjour à tous,

j'espère avoir plus de chance que précédemment.

Pour ceux qui avaient lu mon précédent post, j'ai progressé en farfouillant sur le forum.

Je résume ce que je souhaite faire

J'ai créer un fichier emploi du temps. Grâce à un code VBA, je souhaite qu'en fonction d'un caractère inséré dans une cellule celle ci change automatiquement de couleur.

Auparavant j'avais créé un code avec la commande "If...End if"

Cela fonctionnait mais le code était lourd. De plus il était impossible d'étirer la cellule plus d'une fois car les cellules étirées restaient en blanc. avec le chiffre en noir. De même en créant 2 tableaux avec liaisons la mise en couleur ne se fait pas.

Grâce à un code trouvé sur le forum, j'ai résolu mon premier problème: je peux étirer les cellules. Cependant le code ne fonctionne qu'avec des chiffres. Malheureusement je souhaite pouvoir utiliser des chaines de caractères;

Exemple simple: lorsque je tape dans la cellule le chiffre 3 celle ci passe en jaune .Cela correspond à une journée de congé. J'aimerais pouvoir obtenir en tapant "MAT" ou "APM" (1/2 journée de congé) une cellule en jaune avec les caractères en noir.

Voici le code que j'ai bidouillé:

Private Sub Worksheet_change(ByVal target As Range)
Dim i As Integer, plg As Range
On Error Resume Next
If Not Intersect(target, Range("A1:IV" & Range("A65536").End(xlUp).Row)) Is Nothing _
And target.Count = 1 Then
Set plg = Range(target, target.Offset(0, 0))
Select Case target
Case Is = 1: i = 3
Case Is = 2: i = 29
Case Is = 3: i = 6
Case Is = 4: i = 36
Case Is = 5: i = 50
Case Is = 6: i = 41
Case Is = 7: i = 46
Case Is = 8: i = 10
Case Is = 9: i = 40
Case Is = 10: i = 38
Case Is = 11: i = 1
Case Else
plg.Interior.ColorIndex = xlNone
End Select
plg.Interior.ColorIndex = i
End If
If Not Intersect(target, Range("a1:iv" & Range("a65536").End(xlUp).Row)) Is Nothing _
And target.Count = 1 Then
Set plg = Range(target, target.Offset(0, 0))
Select Case target
Case Is = 1: i = 3
Case Is = 2: i = 29
Case Is = 3: i = 6
Case Is = 4: i = 36
Case Is = 5: i = 50
Case Is = 6: i = 41
Case Is = 7: i = 46
Case Is = 8: i = 10
Case Is = 9: i = 40
Case Is = 10: i = 38
Case Is = 11: i = 1
Case Else
plg.Font.ColorIndex = xlNone
End Select
plg.Font.ColorIndex = i
End If
End Sub

Je ne vous cache pas que je ne comprends pas tout, l'essentiel c'est que ça fonctionne. Mais des explications seraient tout de même les bienvenues.

Si d'ailleurs quelqu'un connait un livre accessible aux débutants, je suis preneurs. Ceux que j'ai achetés partent rapidement dans des codes compliqués.

Merci à tous de votre aide.

G

Bonjour

Essayes

Option Explicit

Private Sub Worksheet_change(ByVal target As Range)
Dim CoulFond As Integer
Dim CoulTexte As Integer

    If Not Intersect(target, Range("A1:IV" & Range("A65536").End(xlUp).Row)) Is Nothing _
                              And target.Count = 1 Then
    Select Case target
      Case Is = 1: CoulFond = 3: CoulTexte = 3
      Case Is = 2: CoulFond = 29: CoulTexte = 29
      Case Is = 3: CoulFond = 6: CoulTexte = 6
      Case Is = 4: CoulFond = 36: CoulTexte = 36
      Case Is = 5: CoulFond = 50: CoulTexte = 50
      Case Is = 6: CoulFond = 41: CoulTexte = 41
      Case Is = 7: CoulFond = 46: CoulTexte = 46
      Case Is = 8: CoulFond = 10: CoulTexte = 10
      Case Is = 9: CoulFond = 40: CoulTexte = 40
      Case Is = 10: CoulFond = 38: CoulTexte = 38
      Case Is = 11: CoulFond = 1: CoulTexte = 1
      Case "MAT", "APM": CoulFond = 6: CoulTexte = 1
      Case Else
        CoulFond = xlNone: CoulTexte = 1
    End Select
    With target
      .Interior.ColorIndex = CoulFond
      .Font.ColorIndex = CoulTexte
    End With
  End If
End Sub

Merci pour votre reponse.

Je l'essaye dès demain et je vous donne le resultat.

Encore merci

Le code fonctionne parfaitement.

Je n'ai pas essayé les liaisons de tableau à tableau. Mais pour le reste et surtout l'enregistrement, c'est beaucoup plus rapide.

Un grand merci.

Sinon avez vous un livre à me conseiller?

G

Bonjour

ferreux a écrit :

Le code fonctionne parfaitement.

Il était prévu pour

ferreux a écrit :

Sinon avez vous un livre à me conseiller?

G

Pas particulièrement mais tu peux commencer par COURS VBA