Mise en forme conditionnelle selon cellu modifiées

Killermix -

Bonjour le forum,

J'aimerais savoir s'il existait un moyen de mettre en forme des cellules selon si elles ont été modifiées récemment?
Il s'agit d'un classeur partagé, l'objectif serait par exemple de mettre en vert toutes les cellules pour lesquelles il y a eu une modification dans les 24 dernières heures?

Ou bien par le biais d'un commentaire automatique associé à la cellule qui indiquerait la date & heure de la modification?

Ma collègue a tenté la fonction "suivi des modifications" de l'onglet Révisions. Néanmoins, il faut que la personne ayant fait la modification soit connectée sur le fichier pour qu'elle apparaisse dans "Afficher les modifications apportées par : xxxx "

N'ayant pas trouvé de mise en forme conditionnelle répondant directement à ma question, je pense partir sur la seconde option qui nécessite VBA (à moins que quelqu'un n'ait une autre solution?)

Pour ce faire, voici une ébauche mais pour laquelle j'aurais besoin d'un peu d'aide... :

Private Sub Worksheet_Change(ByVal Target As Range)

Dim Nom As String
Dim plage As Range

Nom = Environ("USERNAME")

Set plage = Column("K:K")

If Not Application.Intersect(plage, Target) Is Nothing Then
Target.AddComment
Target.Comment.Text Text:="Modifié par " &Nom &" le " &Date
End If
End Sub

Je n'obtiens pas de commentaire lorsque je modifie une cellule de ma feuille, ni dans la colonne K ni dans aucune autre ..

Merci d'avance pour votre aide,

Afficher la suite

5 réponses

ThauTheme

Bonjour Killermix, bonjour le forum,

essaie comme ça :

Private Sub Worksheet_Change(ByVal Target As Range)
Dim Nom As String
Nom = Environ("USERNAME")
If Target.Column <> 11 Then Exit Sub
Target.AddComment
Target.Comment.Text Text:="Modifié par " & Nom & " le " & Date
End Sub

pijaku Modérateur

Bonjour,

Parfois, une feuille intermédiaire peut s'avérer intéressante.

Dans ton cas, je stockerai, dans une feuille (qui pourrait être masquée) créée pour l'occasion, la date et l'heure de chaque modification.

Ensuite, tu fais une procédure qui se déclenche lors de l'événement WorkBooks.Open() qui va boucler sur ces cellules et, en fonction, va supprimer les commentaires inutiles de ta feuille.

Si tu veux encore plus de "précision", cette procédure pourra se lancer automatiquement toutes les heures grâce à la méthode Application.OnTime.

Killermix Auteur

Bonjour Pijaku,

Je viens de tenter d'aller dans la direction que vous m'indiquez :

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
Dim Nom As String

Nom = Environ("USERNAME")
If Target.Column <> 11 Then Exit Sub
If Target.Comment Is Nothing Then
Target.AddComment
Target.Comment.Text Text:="Modifié par " & Nom & " le " & Date & " à " & Time
Feuil2.Cells(Target.Row, 1).Value = Date & " " & Time
    If Feuil2.Cells(Target.Row, 1).Value >= Date - 1 Then
    Feuil2.Cells(Target.Row, 2).Value = "Nouveau"
    Else: Feuil2.Cells(Target.Row, 2).Value = "Ancien"
    End If
Else: Target.Comment.Text Text:="Modifié par " & Nom & " le " & Date & " à " & Time
Feuil2.Cells(Target.Row, 1).Value = Date & "  " & Time
    If Feuil2.Cells(Target.Row, 1).Value >= Date - 1 Then
    Feuil2.Cells(Target.Row, 2).Value = "Nouveau"
    Else: Feuil2.Cells(Target.Row, 2).Value = "Ancien"
    End If
End If
End Sub

Cela m'indique bien dans ma feuille2 la date et l'heure de chaque modification.
J'ai alors ajouté "Nouveau" ou "Ancien" en colonne 2 de cette feuille2 pour voir si le programme fonctionne néanmoins même si je mets If Feuil2.Cells(Target.Row, 1).Value >= Date +1 Then (ce qui devrait être impossible vu qu'on est pas le 26/10, il m'indiquait tout de même "Nouveau"

Une fois ceci réparé, je pourrais entamer l'application ontime qui me semble fort intéressante !

Merci de m'avoir aiguillé,

pijaku Modérateur
1- La notion nouveau ou ancien ne te servira pas.
Mais c'est ton choix.
2- Ici, il faut forcer le format de Date en raison de la présence de Time , comme ceci :
```
If CDate(Feuil2.Cells(Target.Row, 1).Value) >=  Date + 1 Then
```
ou alors, en "plus mieux" :
```
If CDate(Feuil2.Cells(Target.Row, 1).Value) >=  DateAdd("d", -1, Date) Then
```
0

Killermix Auteur

Oui bien sûr, la notion nouveau ou ancien me servait juste à faire le test pour voir si ça changeait bien selon la variable.

En effet, ça ne fonctionnait pas suite au format de ma cellule, CDate() est donc ce qu'il me fallait !

J'ai rajouté le Application.OnTime + 1h pour lancer l'application chaque heure mais même en ayant mis +15secondes pour avoir un raffraichissement rapide me permettant de voir si quelque chose bougeait, je n'ai pas vu de modifications sur mes cellules (j'ai changé également la condition

If CDate(Feuil2.Cells(Target.Row, 1).Value) >= DateAdd("d", -1, Date) Then

en indiquant >= DateAdd("s", -10, Date) ce qui m'aurait en théorie passé ma case du remplissage vert au non remplissage ...

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
Dim Nom As String

Application.OnTime Now + TimeValue("00:00:15"), "Worksheet_Change"

Nom = Environ("USERNAME")
If Target.Column <> 11 Then Exit Sub
If Target.Comment Is Nothing Then
Target.AddComment
Target.Comment.Text Text:="Modifié par " & Nom & " le " & Date & " à " & Time
Feuil2.Cells(Target.Row, 1).Value = Date & " " & Time
    If CDate(Feuil2.Cells(Target.Row, 1).Value) >= DateAdd("s", -10, Date) Then
    With Target.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .Color = 5296274
        .TintAndShade = 0
        .PatternTintAndShade = 0
    End With
    Else:
    With Target.Interior
        .Pattern = xlNone
        .TintAndShade = 0
        .PatternTintAndShade = 0
    End With
    End If
Else: Target.Comment.Text Text:="Modifié par " & Nom & " le " & Date & " à " & Time
Feuil2.Cells(Target.Row, 1).Value = Date & "  " & Time
    If CDate(Feuil2.Cells(Target.Row, 1).Value) >= DateAdd("d", -1, Date) Then
    With Target.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .Color = 5296274
        .TintAndShade = 0
        .PatternTintAndShade = 0
    End With
    Else:
    With Target.Interior
        .Pattern = xlNone
        .TintAndShade = 0
        .PatternTintAndShade = 0
    End With
    End If
End If

End Sub

Killermix Auteur
@KillermixAh oui, j'ai oublié de préciser qu'au bout de ces 15 secondes j'ai le message suivant qui apparaît :

"Argument non facultatif"

Je pense qu'on y est presque ... cela refera t'il une passe sur toutes les cellules de la colonne K ?
0

pijaku Modérateur

Ce n'est pas ce que je te disais.

OnTime ne fonctionne pas avec les procédures événementielles.
Tu dois avoir, dans ton classeur :
> une procédure événementielle Worksheet_Change() qui colorie tes cellules colonne K, ajoute un commentaire et écrit la date en feuil2

> une procédure ("équipée" de Application.OnTime pour pouvoir se relancer seule, indépendamment du reste), dans un module standard qui boucle toutes les heures dans ta feuil2 et qui, le cas échéant, supprime la valeur contenue feuil2, supprime la couleur et le commentaire feuil1

> une procédure événementielle WorkBook_Open() qui lance une première fois ta procédure standard.

Soit :
Dans le module de la feuille :

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
Dim Nom As String

   Nom = Environ("USERNAME")
   If Target.Column = 11 And Target.Cells.Count = 1 Then
      If Target.Comment Is Nothing Then
         Target.AddComment
         Target.Comment.Text Text:="Modifié par " & Nom & " le " & Date & " à " & Time
      Else
         Target.Comment.Text Text:="Modifié par " & Nom & " le " & Date & " à " & Time
      End If
      Feuil2.Cells(Target.Row, 1).Value = Date & " " & Time
      With Target.Interior
         .Pattern = xlSolid
         .PatternColorIndex = xlAutomatic
         .Color = 5296274
         .TintAndShade = 0
         .PatternTintAndShade = 0
      End With
   End If
End Sub

Dans un module standard :

Option Explicit

Sub maMacro()
Dim L As Long, DL As Long
   With Feuil2
      DL = .Range("A" & Rows.Count).End(xlUp).Row
      For L = 1 To DL
         If .Cells(L, 1).Value <> vbNullString Then
            If CDate(.Cells(L, 1).Value) <= DateAdd("d", -1, Now) Then
               With Feuil1.Cells(L, 11)
                   .Interior.Pattern = xlNone
                   .Interior.TintAndShade = 0
                   .Interior.PatternTintAndShade = 0
                   .Comment.Delete
               End With
               .Cells(L, 1).Value = vbNullString
            End If
         End If
      Next
   End With
   Application.OnTime Now + TimeValue("00:00:15"), "maMacro"
End Sub

Dans le module ThisWorkbook :

Option Explicit

Private Sub Workbook_Open()
   maMacro
End Sub

Ne te restes plus qu'à adapter les temps et dates...

N'hésite pas à revenir, même si ça fonctionne.

Bon courage

Killermix Auteur

Merci beaucoup pour le temps passé pijaku !

J'ai une incompatibilité de type (erreur 13) sur la ligne :

If CDate(Feuil1.Cells(L, 11).Value) <= DateAdd("s", -10, .Cells(L, 1).Value) Then

de la macro

Selon moi, ce n'est pas la valeur de la cellule modifiée en feuille 1 qu'il faut comparer
Je l'ai donc modifié comme suit :
Option Explicit

Sub maMacro()
Dim L As Long, DL As Long
   With Feuil2
      DL = .Range("A" & Rows.Count).End(xlUp).Row
      For L = 1 To DL
         If .Cells(L, 1).Value <> vbNullString Then
             If CDate(Feuil2.Cells(L, 1).Value) > DateAdd("s", -10, Time) Then
               With Feuil1.Cells(L, 11)
                   .Interior.Pattern = xlNone
                   .Interior.TintAndShade = 0
                   .Interior.PatternTintAndShade = 0
                   .Comment.Delete
               End With
               .Cells(L, 1).Value = vbNullString
            End If
         End If
      Next
   End With
   Application.OnTime Now + TimeValue("00:00:15"), "maMacro"
End Sub

Résultat, j'obtiens ce que j'aimerais.

Néanmoins, l'application ne se fait pas automatiquement toutes les 15 secondes comme je m'y attendais. Je dois lancer la macro manuellement...

En tout cas merci vraiment pour l'aide apportée, j'essaye de comprendre les codes et y apporter mes modifications (même si ça ne fonctionne pas toujours) et non pas juste attendre une solution miracle :)

On touche au but !!

pijaku Modérateur
```
Application.OnTime Now + TimeValue("00:00:15"), "maMacro"
```
Va relancer toutes les 15 secondes la macro.
Pour la lancer une première fois, utiliser le workboos_Open()
0

Killermix Auteur

C'est vrai, elle se lance automatiquement. Mais y a toujours un problème au niveau de la condition ...

If CDate(Feuil1.Cells(L, 11).Value) <= DateAdd("s", -10, .Cells(L, 1).Value) Then

Voilà comment je lis votre ligne : Si équivalent date de la valeur de la cellule de la feuille 1 inférieur ou égal à date du commentaire - 10 secondes alors

Sauf que là on tente de comparer 2 dates qui sont les mêmes, selon moi il faut comparer cette date de commentaire par rapport au temps actuel donc j'ai tenté :

Sub maMacro()
Dim L As Long, DL As Long
   With Feuil2
      DL = .Range("A" & Rows.Count).End(xlUp).Row
      For L = 1 To DL
         If .Cells(L, 1).Value <> vbNullString Then
             If Time > DateAdd("s", -10, .Cells(L, 1).Value) Then
               With Feuil1.Cells(L, 11)
                   .Interior.Pattern = xlNone
                   .Interior.TintAndShade = 0
                   .Interior.PatternTintAndShade = 0
                   .Comment.Delete
               End With
               .Cells(L, 1).Value = vbNullString
            End If
         End If
      Next
   End With
   Application.OnTime Now + TimeValue("00:00:30"), "maMacro"
End Sub

Voici ce que j'ai modifié :

Une donnée Date et une donnée heure dans deux cellules distinctes

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
Dim Nom As String

   Nom = Environ("USERNAME")
   If Target.Column = 11 Then
      If Target.Comment Is Nothing Then
         Target.AddComment
         Target.Comment.Text Text:="Modifié par " & Nom & " le " & Date & " à " & Time
      Else
         Target.Comment.Text Text:="Modifié par " & Nom & " le " & Date & " à " & Time
      End If
      Feuil2.Cells(Target.Row, 1).Value = Date
      Feuil2.Cells(Target.Row, 2).Value = Time
      With Target.Interior
         .Pattern = xlSolid
         .PatternColorIndex = xlAutomatic
         .Color = 5296274
         .TintAndShade = 0
         .PatternTintAndShade = 0
      End With
   End If
End Sub

Puis dans le second code, d'abord on regarde si on est dans le même jour (si oui, ça reste une nouvelle réf) sinon on compare l'heure. J'ai fait mon test avec des valeurs 10secondes pour voir si ça fonctionnait (et c'est le cas) mais là j'ai lancé pour 14h afin de voir si en passant sur un nouveau jour je vais bien avoir mon commentaire supprimé demain aux alentours de 9h10.

Sub maMacro()
Dim L As Long, DL As Long
   With Feuil2
      DL = .Range("A" & Rows.Count).End(xlUp).Row
      For L = 1 To DL
         If .Cells(L, 1).Value <> vbNullString Then
            If Now > CDate(Feuil2.Cells(L, 1).Value) Then
             If Time > DateAdd("h", 14, Feuil2.Cells(L, 2).Value) Then
               With Feuil1.Cells(L, 11)
                   .Interior.Pattern = xlNone
                   .Interior.TintAndShade = 0
                   .Interior.PatternTintAndShade = 0
                   .Comment.Delete
               End With
               .Cells(L, 1).Value = vbNullString
               .Cells(L, 2).Value = vbNullString
                End If
            End If
         End If
      Next
   End With
   Application.OnTime Now + TimeValue("00:30:00"), "maMacro"
End Sub

Merci beaucoup, je reviens vers vous demain si le test final fonctionne !

pijaku Modérateur
Bonjour,
En effet, une erreur de ma part. J'ai modifié la ligne 9 du code de la procedure maMacro qui devrait fonctionner.

EDIT : à noter également l'utilisation de Now au lieu de Date pour tenir compte de l'heure.
0
Killermix Auteur
Bonjour Pijaku,

Mon code n'a pas fonctionné ce matin, le problème doit venir du changement de jour car avec mes tentatives à 10/15secondes d'intervalle cela fonctionnait.
Je viens de tenter votre ligne de code,
```
If CDate(.Cells(L, 1).Value) <= DateAdd("d", -1, Now) Then
```
qui devrait fonctionner, mais je ne sais pas si cela prendra en compte l'heure également? (chose que j'essayais de faire dans mon code avec le SI(jour<inférieur) alors SI(heure<inférieur)

Je reviens vers vous au plus vite ! Si demain à 7h ma ligne apparaît toujours mais qu'à 9h15 elle disparait, alors l'objectif aura été accompli :)

En tout cas merci beaucoup pour votre patience
0

Réponse 4 / 5
Killermix Auteur
Bonjour ThauTheme,

Merci ça fonctionne bien, j'ai également rajouté l'heure pour avoir une donnée précise.
Lorsque je modifie une cellule je vois bien un commentaire s'ajouter, néanmoins si je modifie une cellule que j'ai déjà modifié le programme bug à cause du code "Target.AddComment".

J'ai donc apporté la modification suivante qui fonctionne :
```
Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
Dim Nom As String
Nom = Environ("USERNAME")
If Target.Column <> 11 Then Exit Sub
If Target.Comment Is Nothing Then
Target.AddComment
Target.Comment.Text Text:="Modifié par " & Nom & " le " & Date & " à " & Time
Else: Target.Comment.Text Text:="Modifié par " & Nom & " le " & Date & " à " & Time
End If
End Sub
```
Pour aller un peu plus loin, serait-il possible par exemple de mettre en évidence les modifications apportées depuis notre dernière connexion? (propre à chaque utilisateur). Chose que je pense être assez complexe ...

Ou bien plutôt de mettre en évidence tous les commentaires modifiés dans les dernières 24heures?

Ceci est bien évidemment dans le but de perfectionner l'actuelle fonction qui me convient déjà bien !
0
1. ThauTheme
  
  Re,
  
  Heu... Bonne chance... Ça dépasse mes conpétences...
  
  0
2. Killermix Auteur
  
  @ThauThemeCe n'est pas grave, je vais y arriver !
  Je pense qu'avec une formule si prenant en compte la date qui est inscrite dans le commentaire par rapport à la date actuelle, il y a quelque chose à faire :)
  
  Si j'ai du nouveau je vous le communique et si quelqu'un d'autre peut éclairer ma lanterne, je suis preneur !
  
  0
Vous n’avez pas trouvé la réponse que vous recherchez ?

La communauté CCM répond en moyenne en moins de 2h.

Posez votre question

f894009

Bonjour,

Pour colonne K

Private Sub Worksheet_Change(ByVal Target As Range)

Dim Nom As String
Dim plage As Range

Nom = Environ("USERNAME")

Set plage = Columns("K:K")

If Not Application.Intersect(plage, Target) Is Nothing Then
    Target.AddComment
    Target.Comment.Text Text:="Modifi? par " & Nom & " le " & Date
End If
End Sub

ni dans la colonne K ni dans aucune autre ..

C'est quoi aucune autre???

Killermix Auteur

Bonjour f894009,

J'étais parti sur de mauvaises bases :

Avec de l'aide, nous avons avancé dans le débat :

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
Dim Nom As String

Application.OnTime Now + TimeValue("00:00:15"), "Worksheet_Change"

Nom = Environ("USERNAME")
If Target.Column <> 11 Then Exit Sub
If Target.Comment Is Nothing Then
Target.AddComment
Target.Comment.Text Text:="Modifié par " & Nom & " le " & Date & " à " & Time
Feuil2.Cells(Target.Row, 1).Value = Date & " " & Time
    If CDate(Feuil2.Cells(Target.Row, 1).Value) >= DateAdd("s", -10, Date) Then
    With Target.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .Color = 5296274
        .TintAndShade = 0
        .PatternTintAndShade = 0
    End With
    Else:
    With Target.Interior
        .Pattern = xlNone
        .TintAndShade = 0
        .PatternTintAndShade = 0
    End With
    End If
Else: Target.Comment.Text Text:="Modifié par " & Nom & " le " & Date & " à " & Time
Feuil2.Cells(Target.Row, 1).Value = Date & "  " & Time
    If CDate(Feuil2.Cells(Target.Row, 1).Value) >= DateAdd("d", -1, Date) Then
    With Target.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .Color = 5296274
        .TintAndShade = 0
        .PatternTintAndShade = 0
    End With
    Else:
    With Target.Interior
        .Pattern = xlNone
        .TintAndShade = 0
        .PatternTintAndShade = 0
    End With
    End If
End If

End Sub

Désormais, un commentaire s'affiche bien au bon endroit lorsqu'il y a eu une modification sur une cellule de la colonne K.

L'objectif est actuellement de mettre en valeurs tous les commentaires ayant été modifiés récemment. Chaque heure la fonction est relancée pour faire une passe sur les nouveautés (en théorie) mais je n'arrive pas à avoir le résultat escompté car même en faisant un essai dans l'immédiat (raffraichissement toutes les 15secondes, cellule à passer du remplissage vert (nouvelle) à aucun remplissage (ancienne) grâce à

If CDate(Feuil2.Cells(Target.Row, 1).Value) >= DateAdd("s", -10, Date) Then

Mais à nouveau, ce n'est qu'en théorie car cela ne fonctionne pas. Au bout des 15 secondes j'ai un message "Argument non facultatif" qui apparaît ...

Si vous avez un éclaircissement je suis preneur !

EDIT : Ajout des balises de code (la coloration syntaxique).
Explications disponibles ici : ICI

Merci d'y penser dans tes prochains messages.

pijaku Modérateur
As-tu vu ma réponse n°11?
https://forums.commentcamarche.net/forum/affich-35656933-mise-en-forme-conditionnelle-selon-cellu-modifiees#11
0
Killermix Auteur
Hello,

En effet je ne l'avais pas vu... Je m'y mets, merci beaucoup !
0

Mise en forme conditionnelle selon cellu modifiées

5 réponses

Discussions similaires

Newsletters