Format conditionnel cellules adjacentes

Bonjour le FORUM.

Peut on mettre en forme (+ de 3) des cellules en fonction de la valeur d'une autre cellule.

Voir fichier joint

https://www.excel-pratique.com/~files/doc/couleurs.xls

Merci d'avance

Annette

bonjour,

Si j'ai bien compris... la macro ci dessous devrait résoudre ton problème.

Private Sub Worksheet_Change(ByVal Target As Range)
Dim i%, o
If Target.Count = 1 Then
Set o = Application.Intersect(Range("E3:E10"), Target)
If Not o Is Nothing Then
  Select Case Target
      Case 1: i = 34
      Case 2: i = 35
      Case 3: i = 28
      Case 4: i = 37
      Case 5: i = 33
      Case 6: i = 41
      Case 7: i = 32
      Case Else: i = xlNone
  End Select
End If
Target.Offset(0, -1).Resize(1, 5).Interior.ColorIndex = i
End If
End Sub

ou encore...

Private Sub Worksheet_Change(ByVal Target As Range)
Dim i%, k%, o
If Target.Count = 1 Then
k = Target.Row
Set o = Application.Intersect(Range("E3:E10"), Target)
If Not o Is Nothing Then
  Select Case Target
      Case 1: i = 34
      Case 2: i = 35
      Case 3: i = 28
      Case 4: i = 37
      Case 5: i = 33
      Case 6: i = 41
      Case 7: i = 32
      Case Else: i = xlNone
  End Select
End If
Range(Cells(k, 4), Cells(k, 8)).Interior.ColorIndex = i
End If
End Sub

A+

Bonjour le Forum,

Merci à galopin01 pour son code.

Serait il possible d'améliorer celui ci en récupérant une couleur définie dans une autre cellule

Voir fichier joint

https://www.excel-pratique.com/~files/doc/_essai_couleur.xls

Amicalement

Annette

bonjour,

Essaie ça :

Private Sub Worksheet_Change(ByVal Target As Range)
Dim i%, k%, o
If Target.Count = 1 Then
k = Target.Row
Set o = Application.Intersect(Range("E2:E19"), Target)
    If Not o Is Nothing Then i = Target + 1
Range(Cells(k, 4), Cells(k, 8)).Interior.ColorIndex = Cells(i, 3).Interior.ColorIndex
End If
End Sub

A+

RE:

Merci Galopin01

Pour le code, il reste une anomalie .La saisie dans une autre cellule provoque une erreur.

A te relire

Annette

Ci joint l'appli exemple

https://www.excel-pratique.com/~files/doc/_essai_couleur2.xls

bonjour,

C'est vrai que je ne débogue pas souvent quand je vous fais quelques lignes de code !

La solution :

Private Sub Worksheet_Change(ByVal Target As Range)
Dim i%, k%, o
    If Target.Count = 1 Then
            k = Target.Row
            Set o = Application.Intersect(Range("E2:E19"), Target)
        If Not o Is Nothing Then
          i = Target + 1
          Range(Cells(k, 4), Cells(k, 8)).Interior.ColorIndex = Cells(i, 3).Interior.ColorIndex
        End If
    End If
End Sub

A+

Re bonjour le Forum

galopin01

Le code donné ci dessus donne une couleur au delà de la colonne H si une cellule est modifiée (exemple cellule(" I2") modifiée ---> format couleur modifié)

Que faut_il modifier dans ce code ?

Merci et à bientôt

Annette

Heu... Là, je ne comprend pas la question

La cellule I2 n'a rien à voir dans cette macro puisqu'elle ne s'applique qu'aux modifications de Range("E2:E19")

Elle entraine un changement de couleur des colonnes 4 à 8 (même ligne)

re bonjour

J' ai pour essai, positionné dans le code avant le End Sub :

k = 0 et je n'ai plus le problème. Est ce la solution?

D'autre part il serait intéressant pour pour éviter une "incompatibilité de type" de mettre à zéro la cellule sélectionnée ("E2") à ("E19") si saisie en Alpha.

A te relire

Annette

Une version modifiée pour gérer une éventuelle saisie alpha :

Private Sub Worksheet_Change(ByVal Target As Range)
Dim i%, k%, o
    If Target.Count = 1 Then
            k = Target.Row
            Set o = Application.Intersect(Range("E2:E19"), Target)
            On Error GoTo GESTERR
        If Not o Is Nothing Then
          i = Target + 1
          Range(Cells(k, 4), Cells(k, 8)).Interior.ColorIndex = Cells(i, 3).Interior.ColorIndex
        End If
    End If
Exit Sub
GESTERR:
  Beep
  Target.ClearContents
  Resume Next
End Sub

Mais je n'ai toujours rien compris à la question précédente.

Quand au k=0 il ne sert à rien donc tu peux le virer.

A+

Bonsoir à tous;

Le code me convient parfaitement et je vais l'imbriquer dans mon programme.

Merci à Galopin01 qui a solutionner rapidement mes souhaits.

Amicalement

Annette