MFC par VBA

[Danielle444]

Bonjour,

J'ai un code VBA pour mettre en couleur le fond des cellules il fonctionne très bien sur une valeur de cellule entière (MALADE) mais j'aimerai qu'il fonctionne aussi sur les cellules contenant une phrase (toto est MALADE) le code est le suivant :

Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect([ChampMFC], Target) Is Nothing Then
On Error Resume Next
Target.Interior.ColorIndex = [couleurs].Find(Target, LookAt:=xlPart, MatchCase:=False _
, SearchFormat:=False).Interior.ColorIndex
End If
End Sub

Merci d'avance

 

[tototiti2008]

Re : MFC par VBA

Bonjour Danielle,

un essai

Private Sub Worksheet_Change(ByVal Target As Range)
Dim Cellule as Range
If Not Intersect([ChampMFC], Target) Is Nothing Then
On Error Resume Next
For Each Cellule in Range("Couleurs")
If Target.Value Like "*" & Cellule.value & "*" then
Target.Interior.ColorIndex = Cellule.Interior.ColorIndex
Exit For
end If
Next
End If
End Sub

 

[pierrejean]

Re : MFC par VBA

Bonjour Danielle44
A tester

Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect([ChampMFC], Target) Is Nothing Then
for each coul in [couleurs]
  if instr(target,coul.value)<>0 then Target.Interior.ColorIndex =coul.interior.colorindex
next 
End If
End Sub

Edit: Salut Tototiti

 

[Danielle444]

Re : MFC par VBA

Merci pour vos réponses super rapides mais ça ne marche toujours pas 😱

En fait dans [couleurs] zone comportant les codes
et dans champMFC zone à mettre en forme

Merci

 

[tototiti2008]

Re : MFC par VBA

Salut PierreJean 😉
Re,

Nos codes sont trés proches, ça ne m'étonnes pas que si l'un ne fonctionne pas, l'autre non plus

VBA est sensible à la casse, est-ce que tu as un malade en majuscules et l'autre en minuscules ?

si oui, essaye

Private Sub Worksheet_Change(ByVal Target As Range)
Dim Cellule as Range
If Not Intersect([ChampMFC], Target) Is Nothing Then
On Error Resume Next
For Each Cellule in Range("Couleurs")
If ucase(Target.Value) Like "*" & ucase(Cellule.value) & "*" then
Target.Interior.ColorIndex = Cellule.Interior.ColorIndex
Exit For
end If
Next
End If
End Sub

ou

Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect([ChampMFC], Target) Is Nothing Then
for each coul in [couleurs]
  if instr(ucase(target),ucase(coul.value))<>0 then Target.Interior.ColorIndex =coul.interior.colorindex
next 
End If
End Sub

 

[BOISGONTIER]

Re : MFC par VBA

Bonjour,

http://boisgontierjacques.free.fr/fichiers/MFC/MFCPlus3coul.xls (cf cas3)

Private Sub Worksheet_Change(ByVal Target As Range)
  If Not Intersect([ChampMFC], Target) Is Nothing Then
    Target.Interior.ColorIndex = xlNone
    For Each c In [couleurs]
      If InStr(UCase(Target), UCase(c)) > 0 And c <> "" Then Target.Interior.ColorIndex = c.Interior.ColorIndex
    Next
  End If
End Sub

JB

 

[Danielle444]

Re : MFC par VBA

En fait ce qui ne fonctionne pas c'est quand je rentre une phrase avec le mot "malade" c'est là que ça ne prend pas

 

[tototiti2008]

Re : MFC par VBA

Bonjour Boisgontier,
Re,

Dans la mesure où chaque cellule de ta plage couleurs contient un mot, nos 3 codes fonctionnent (je viens de tester)

Si certaines cellules de [couleurs] sont vides, prend celui de Boisgontier

 

[Danielle444]

Re : MFC par VBA

Et dans les formules ? exemple : concatener (...)😱

 

[Danielle444]

Re : MFC par VBA

Merci

Avec le code de BOISGONTIER ça fonctionne aussi dans les formules

Un grand merci à vous tous