changement de couleur d'une cellule seulement à sa deuxième modification

sebbbbb

XLDnaute Impliqué
bonjour
j'ai cherché pas mal dans les forums sans succès.
je souhaiterai que cellule E15 change de couleur non pas lorsque l'on écrit dedans pour la 1ere fois mais seulement à la deuxième.
en résumé si j'écrit des données en E15 pour le 1ere fois celles ci sont de couleur rouge et si je fais un modif les données apparaissent en noir.
je précise que les MFC ne sont pas possibles car je ne sais pas à l'avnce ce qui pourra être inscrit
un grand merci par avance
seb
 

sebbbbb

XLDnaute Impliqué
Bonjour double zéro

j'ai essayé d'adapter ton code dans mon fichier mais il y a un hic car j'ai déjà un code dans mon onglet et le mix ne se fait pas

Sais tu comment joindre ton code au mien sans qu'il y ait de bug stp ?

ci-dessous mon code actuel

***

Private Sub Worksheet_Change(ByVal Target As Range)

If Not Application.Intersect(Target, Range("M2")) Is Nothing Then
Application.EnableEvents = False
Target = UCase(Target)
Application.EnableEvents = True
End If

If Not Application.Intersect(Target, Range("A5")) Is Nothing Then
Application.EnableEvents = False
Target = UCase(Target)
Application.EnableEvents = True
End If

If Not Application.Intersect(Target, Range("Q6")) Is Nothing Then
Application.EnableEvents = False
Target = UCase(Target)
Application.EnableEvents = True
End If

If Not Application.Intersect(Target, Range("Q8")) Is Nothing Then
Application.EnableEvents = False
Target = UCase(Target)
Application.EnableEvents = True
End If

If Not Application.Intersect(Target, Range("M5")) Is Nothing Then
Application.EnableEvents = False
Target = UCase(Target)
Application.EnableEvents = True
End If

If Not Application.Intersect(Target, Range("AA5")) Is Nothing Then
Application.EnableEvents = False
Target = UCase(Target)
Application.EnableEvents = True
End If

If Not Application.Intersect(Target, Range("E15")) Is Nothing Then
Application.EnableEvents = False
Target = UCase(Target)
Application.EnableEvents = True
End If

If Not Application.Intersect(Target, Range("AE6")) Is Nothing Then
Application.EnableEvents = False
Target = UCase(Target)
Application.EnableEvents = True
End If

If Not Application.Intersect(Target, Range("AE14")) Is Nothing Then
Application.EnableEvents = False
Target = UCase(Target)
Application.EnableEvents = True
End If

If Not Application.Intersect(Target, Range("AE15")) Is Nothing Then
Application.EnableEvents = False
Target = UCase(Target)
Application.EnableEvents = True
End If

If Not Application.Intersect(Target, Range("AE16")) Is Nothing Then
Application.EnableEvents = False
Target = UCase(Target)
Application.EnableEvents = True
End If

If Not Application.Intersect(Target, Range("AE17")) Is Nothing Then
Application.EnableEvents = False
Target = UCase(Target)
Application.EnableEvents = True
End If

If Not Application.Intersect(Target, Range("A20")) Is Nothing Then
Application.EnableEvents = False
Target = UCase(Target)
Application.EnableEvents = True
End If

If Not Application.Intersect(Target, Range("U20")) Is Nothing Then
Application.EnableEvents = False
Target = UCase(Target)
Application.EnableEvents = True
End If

If Not Application.Intersect(Target, Range("A24")) Is Nothing Then
Application.EnableEvents = False
Target = UCase(Target)
Application.EnableEvents = True
End If

If Not Application.Intersect(Target, Range("U24")) Is Nothing Then
Application.EnableEvents = False
Target = UCase(Target)
Application.EnableEvents = True
End If

End Sub

***

1001 merci par avance
seb
 

DoubleZero

XLDnaute Barbatruc
Bonjour à toutes et à tous,
... j'ai essayé d'adapter ton code dans mon fichier mais il y a un hic car j'ai déjà un code dans mon onglet et le mix ne se fait pas...
A l'avenir, merci de bien vouloir déposer le fichier de travail, sans donnée confidentielle, avec le(s) code(s) éventuellement présent(s).

Le fichier joint convient-il ?

A bientôt :)
 

Pièces jointes

  • 00 - sebbbbb - Modification repérer, majuscule insérer v4 .xlsm.xlsm
    15.8 KB · Affichages: 40

sebbbbb

XLDnaute Impliqué
bonjour et merci pour tout ce travail
il ya un bug (voir imp ecran). j'ai portant déprotéger mon onglet et la cellule AZ1.
vois tu ce qui peut bugger?

upload_2017-8-31_15-7-15.png
 

Pièces jointes

  • upload_2017-8-31_15-6-4.png
    upload_2017-8-31_15-6-4.png
    156.4 KB · Affichages: 32

Sylvain

XLDnaute Occasionnel
Bonjour,

Juste une autre idée qui va fonctionner avec toutes les cellules qui auront été mises en rouge :
VB:
Private Sub Worksheet_Change(ByVal Target As Range)
  With Target.Range("a1")
    If .Font.Color = RGB(255, 0, 0) Then
      .Font.Color = RGB(254, 0, 0)
    ElseIf .Font.Color = RGB(254, 0, 0) Then
      .Font.Color = RGB(0, 0, 0)
    End If
  End With
End Sub
 

sebbbbb

XLDnaute Impliqué
j'ai trouvé la solution...du moins a moitié :oops:

j'ai entré le déverouillage de l'onglet pour le remettre ensuite comme suit

ActiveSheet.Unprotect
If Range("az1") = "" Then c.Font.ColorIndex = 8 Else c.Font.ColorIndex = 2
ActiveSheet.Protect

le problème c'est que maintenant la couleur de la police de la cellule A15 reste constamment rouge même au deuxième changement

je n'y comprends plus rien

j'ai pourtant fait la même chose sur ton fichier et celà marche parfaitement
y a t il une astuce ?
merci
seb
 
Dernière édition:

sebbbbb

XLDnaute Impliqué
c'est çà le hic en fait .
Dans mon fichier la cellule AZ1 (qui est déverouillée) ne copie les données comme dans ton fichier test. c'est pourtant un copie coller de ton code que j'ai collé
vois tu une solution stp
un grand merci par avance
seb
 

Discussions similaires

Membres actuellement en ligne

Aucun membre en ligne actuellement.

Statistiques des forums

Discussions
311 725
Messages
2 081 941
Membres
101 848
dernier inscrit
Djigbenou