[Excel2016] Texte dans une cellule en fonction de la couleur d'une autre

Bonjour

Avec macro
https://mon-partage.fr/f/P0i6t3Lg/

Alt_F11 pour accéder au code

Cdlmnt

Merci pour votre aide mais mon niveau est assez bas pour comprendre exactement ce qu'il faut faire.
Je vais lire attentivement.
Cdt
Mwasikitoko

Bonjour

Le même avec quelques explications.
https://mon-partage.fr/f/dr4rKfwj/

Pour tester, tu sélectionnes une cellule date, tu entres une date, tu valides

Pour mettre le code dans ton fichier
Étape 1. Depuis mon fichier
1. Alt-F11 pour accéder au code
2. Ctrl+a pour sélectionner tout
3. Ctrl+c pour copier
Étape 2. Depuis ton fichier
1. Tu te places dans la feuille à traiter
2. Alt-F11 pour accéder à l'éditeur vba
3. Tu colles l'intégralité de mon code
4. Tu enregistres ton fichier avec le type l'extension .xlsm (Fichier/Enregistrer sous/ Type .... prenant en compte les macros)

Cdlmnt

Merci CCM81,
Je teste de suite et te fais un retour.
D'avance merci de m'avoir apporté une solution.
Mwasikitoko

Bonjour
J'ai copié collé le code dans mon classeur dans lequel il y a déjà une procédure
Et ça marche pas

 Option Explicit

Const codat = "N"   ' colonne date
Const coeta = "O"   ' colonne etat accord
' codes couleurs
Const rouge = &HFF
Const orange = &H1175D9
Const jaune = &H9C4FF
Const vert = &H6600
Const noir = &H0

Private Sub Worksheet_Change(ByVal Target As Range)
'Ouverture d'une procédure Sub pour modifier le contenu de la colonne I de la feuille Liste Accords
'Ci-dessous déclaration de la variable V1 comme plage de cellule avec l'instruction DIM ... As Range
Dim Vl As Range
Dim d As Date, li As Long, c As Range, m As Long, a As Long, j As Long
Dim dm6 As Date, dm3 As Date, am6 As Long, mm6 As Long, mm3 As Long, am3 As Long
Dim dd As Date
'Instruction ci-dessous : la procédure se déclenche quand clic n'importe où dans la colonne I uniquement
  If Not Intersect([I:I], Target) Is Nothing And Target.Count = 1 Then
'désactive les événements
    Application.EnableEvents = False
'Valeurs de la plage
    ValSaisie = Target
    Application.Undo
    p = InStr(Target, ValSaisie)
    If p > 0 Then
      Target = Left(Target, p - 1) & Mid(Target, p + Len(ValSaisie) + 1)
      If Right(Target, 1) = Chr(10) Then
        Target = Left(Target, Len(Target) - 1)
      End If
    Else
        If Target = "" Then
          Target = ValSaisie
        Else
          Target = Target & Chr(10) & ValSaisie
        End If
    End If
    Application.EnableEvents = True
 End If
 'Fin de la procédure Sub pour modifier le contenu de la colonne I de la feuille Liste Accords
'Si plus d'une cellule est sélectionnée, fin de la Sub...
If Target.Count > 1 Then Exit Sub
'Attribution de la plage Col. J à la variable V1 avec instruction SET
Set Vl = Range("J:J")
'La procédure se déclenche quand on clique n'importe où dans la colonne J uniquement
If Not Intersect(Vl, Target) Is Nothing Then
Application.EnableEvents = False
'La valeur target comprendra les 3 premières lettres de la valeur affichée dans la cellule après choix liste déroulante
    Target = Left(Target, 3)
    Application.EnableEvents = True
End If

' si plus d'une cellule changée, on quitte
If Target.Count > 1 Then Exit Sub
' si on est en colonne codat on y va
If Not Intersect(Target, Columns(codat)) Is Nothing Then
  ' date du jour + année, mois jour de la date du jour
  dd = Date
  a = Year(dd): m = Month(dd): j = Day(dd)
  ' date saisie
  d = Target.Value
  ' calcul dd + 6 mois
  If m > 6 Then
     am6 = a + 1: mm6 = (m + 6) Mod 12
  Else
     am6 = a: mm6 = m + 6
  End If
  dm6 = CDate(j & "/" & mm6 & "/" & am6)
  ' calcul dd + 3 mois
  If m > 9 Then
    am3 = a + 1: mm3 = (m + 3) Mod 12
  Else
    am3 = a: mm3 = (m + 3)
  End If
  dm3 = CDate(j & "/" & mm3 & "/" & am3)
  ' c = cellule à remplir
  li = Target.Row
  Set c = Range(coeta & li)
  ' remplir c selon les 3 cas envisagées
  Select Case d
    ' cas : date du jour < date saisie
    Case Is < dd:
      c.Value = "Expiré": c.Font.Color = rouge
      c.Font.Bold = True
    ' date du jour inférieure à date du jour + 3 mois
    Case Is < dm3:
      c.Value = "Expiré dans moins de 3 mois"
      c.Font.Color = noir
      c.Characters(Start:=1, Length:=6).Font.Color = rouge
      c.Characters(Start:=1, Length:=6).Font.Bold = True
      c.Characters(Start:=22, Length:=6).Font.Color = rouge
      c.Characters(Start:=22, Length:=6).Font.Bold = True
    ' date du jour inférieure à date du jour + 6 mois
    Case Is < dm6:
      c.Value = "Expiration dans moins de 6 mois"
      c.Font.Color = noir
      c.Characters(Start:=1, Length:=10).Font.Color = rouge
      c.Characters(Start:=1, Length:=10).Font.Bold = True
      c.Characters(Start:=26, Length:=6).Font.Color = rouge
      c.Characters(Start:=26, Length:=6).Font.Bold = True
    ' autres cas
    Case Else:
      c.Value = "En cours": c.Font.Color = vert
      c.Font.Bold = True
  End Select
End If
End Sub

Vraiment je suis désabusée ;0)
Mwasikitoko

Et ça marche pas
Depuis mon fichier ?

C'est idem
Je le renvoie pour essai
https://www.cjoint.com/c/JEkrFhHVTnl
Et je voulais dire merci pour le code VBA documenté...
Merci d'avance pour ton retour
Mwasikitoko

Chez moi ça fonctionne comme prévu
As tu bien changé la date en colonne N (la procédure W_Change, comme son nom l'indique, réagit après un changement de valeur)
ou bien
clic N2 puis clic dans la zone de formule , tu te places à la fin de la date affichée (clic) puis tu valides

Si c'est bien le résultat attendu, il faudra se pencher sur ton fichier

Oui ...j'ai accepté les macros...
Mais je crois que je n'ai pas compris l'instruction
"Pour tester, tu sélectionnes une cellule date, tu entres une date, tu valides" en message 3
Je vais donc renseigne donc faire exécuter la procédure_Change..
C'est tellement logique...
Un petit test et puis reviens...
Merci
Mwasikitoko

C'est un mystère...

Est ce que je peux envoyer le fichier complet en message privé, si ça dérange pas ?

Mais je crois que je n'ai pas compris l'instruction
"Pour tester, tu sélectionnes une cellule date, tu entres une date, tu valides"
Ben, en colonne N tu effaces une date, tu la remets et ça devrait fonctionner (je parle là depuis mon fichier histoire de voir si ça correspond à ce que tu veux)

Pour le tien
1. il aut déclarer toutes les variables (tu as oublié ValSaisie au moins comme dit michel)
Dim ValSaisie
sans préciser le type
2. on verra après mais tu peux me l'envoyer via la MP

> Michel. Salut amical et bien rincé que d'eau, que d'eau par ici !

Bonne journée