mise en forme conditionnelle avancé ....

[jp]

Bonjour , apres qq heures sur vb ... je lache ...

Voila je voudrais :
1 detecter la couleurs de la case ... et appliquer une couleur de fonte ...

mais sa marche pas mon truc :

Private Sub Worksheet_Change(ByVal Target As Range)
Dim Maplage As Range
Dim Cell As Range
Dim CI As Byte
Application.ScreenUpdating = False
Set Maplage = Sheets("Fabrication").Range("F1:F60")
If Not Intersect(Target, Maplage) Is Nothing Then
For Each Cell In Maplage
Select Case Cell
Case Cell.Interior.ColorIndex = 5: CI = 8
End Select
With Cell.Font
.ColorIndex = CI
End With
Next Cell
End If
Application.ScreenUpdating = True
End Sub

si qq pouvait eclairer ma lanterne ;-)) .. merci d'avance.

 

[CHti160]

Salut"jp"

un essai en Range("A1:A10")

Private Sub Worksheet_Change(ByVal Target As Range)
Dim Maplage As Range
Dim Cell As Range
Dim CI As Byte
Dim CIC As Long
Application.ScreenUpdating = False
Set Maplage = Sheets("Feuil1").Range("A1:A10")
If Intersect(Target, Maplage) Is Nothing Then Exit Sub
For Each Cell In Maplage
CIC = Cell.Interior.ColorIndex
Select Case CIC
Case Is = 6: CI = 3
With Cell.Font
.ColorIndex = CI
End With
End Select
Next Cell
Application.ScreenUpdating = True
End Sub
à adapter à ton problème
A+++
Jean Marie

 

[jp]

Merci sa marche presque ....

il ne prend que la derniere valeur de cic ...et ne met pas a jour les autres .

Private Sub Worksheet_Change(ByVal Target As Range)
Dim Maplage As Range
Dim Cell As Range
Dim CI As Byte
Dim CIC As Long
Application.ScreenUpdating = False
Set Maplage = Sheets("Feuil1").Range("A1:A40")
If Intersect(Target, Maplage) Is Nothing Then Exit Sub
For Each Cell In Maplage
CIC = Cell.Interior.ColorIndex
Select Case CIC
Case 6: CI = 8
Case 44: CI = 9
Case 13: CI = 7
With Cell.Font
.ColorIndex = CI
End With
End Select
Next Cell
Application.ScreenUpdating = True
End Sub

 

[CHti160]

Salut"jp"
je ne sais pas si tu as trouvé mais cela devrait régler le problème
Private Sub Worksheet_Change(ByVal Target As Range)
Dim Maplage As Range
Dim Cell As Range
Dim CI As Byte
Dim CIC As Long
Application.ScreenUpdating = False
Set Maplage = Sheets("Feuil1").Range("A1:A40")
If Intersect(Target, Maplage) Is Nothing Then Exit Sub
For Each Cell In Maplage
CIC = Cell.Interior.ColorIndex
Select Case CIC
Case 6: CI = 8
With Cell.Font '<--rajouter
.ColorIndex = CI
End With
Case 44: CI = 9
With Cell.Font '<----rajouter
.ColorIndex = CI
End With
Case 13: CI = 7
With Cell.Font
.ColorIndex = CI
End With
End Select
Next Cell
Application.ScreenUpdating = True
End Sub

A+++
Jean Marie

 

[jp]

Merci pour ton aide .. super sympa SA marche !!! yes !! trop cool .......