Mise en forme conditionnelle selon cellu modifiées

Fermé
Killermix Messages postés 17 Date d'inscription lundi 16 octobre 2017 Statut Membre Dernière intervention 26 octobre 2018 - Modifié le 25 oct. 2018 à 09:44
Killermix Messages postés 17 Date d'inscription lundi 16 octobre 2017 Statut Membre Dernière intervention 26 octobre 2018 - 26 oct. 2018 à 09:25
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,
A voir également:

5 réponses

ThauTheme Messages postés 1442 Date d'inscription mardi 21 octobre 2014 Statut Membre Dernière intervention 29 juillet 2022 160
25 oct. 2018 à 09:37
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

1
pijaku Messages postés 12263 Date d'inscription jeudi 15 mai 2008 Statut Modérateur Dernière intervention 4 janvier 2024 2 752
25 oct. 2018 à 11:12
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.
1
Killermix Messages postés 17 Date d'inscription lundi 16 octobre 2017 Statut Membre Dernière intervention 26 octobre 2018
Modifié le 25 oct. 2018 à 12:06
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é,
0
pijaku Messages postés 12263 Date d'inscription jeudi 15 mai 2008 Statut Modérateur Dernière intervention 4 janvier 2024 2 752
25 oct. 2018 à 12:22
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 Messages postés 17 Date d'inscription lundi 16 octobre 2017 Statut Membre Dernière intervention 26 octobre 2018
Modifié le 25 oct. 2018 à 13:46
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
0
Killermix Messages postés 17 Date d'inscription lundi 16 octobre 2017 Statut Membre Dernière intervention 26 octobre 2018 > Killermix Messages postés 17 Date d'inscription lundi 16 octobre 2017 Statut Membre Dernière intervention 26 octobre 2018
25 oct. 2018 à 13:47
Ah 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 Messages postés 12263 Date d'inscription jeudi 15 mai 2008 Statut Modérateur Dernière intervention 4 janvier 2024 2 752
Modifié le 26 oct. 2018 à 09:13
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

1
Killermix Messages postés 17 Date d'inscription lundi 16 octobre 2017 Statut Membre Dernière intervention 26 octobre 2018
25 oct. 2018 à 15:43
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 !!
0
pijaku Messages postés 12263 Date d'inscription jeudi 15 mai 2008 Statut Modérateur Dernière intervention 4 janvier 2024 2 752
25 oct. 2018 à 15:45
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 Messages postés 17 Date d'inscription lundi 16 octobre 2017 Statut Membre Dernière intervention 26 octobre 2018
25 oct. 2018 à 17:11
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 !
0
pijaku Messages postés 12263 Date d'inscription jeudi 15 mai 2008 Statut Modérateur Dernière intervention 4 janvier 2024 2 752
Modifié le 26 oct. 2018 à 09:09
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 Messages postés 17 Date d'inscription lundi 16 octobre 2017 Statut Membre Dernière intervention 26 octobre 2018
26 oct. 2018 à 09:25
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
Killermix Messages postés 17 Date d'inscription lundi 16 octobre 2017 Statut Membre Dernière intervention 26 octobre 2018
Modifié le 25 oct. 2018 à 10:21
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
ThauTheme Messages postés 1442 Date d'inscription mardi 21 octobre 2014 Statut Membre Dernière intervention 29 juillet 2022 160
25 oct. 2018 à 10:32
Re,

Heu... Bonne chance... Ça dépasse mes conpétences...
0
Killermix Messages postés 17 Date d'inscription lundi 16 octobre 2017 Statut Membre Dernière intervention 26 octobre 2018 > ThauTheme Messages postés 1442 Date d'inscription mardi 21 octobre 2014 Statut Membre Dernière intervention 29 juillet 2022
25 oct. 2018 à 10:52
Ce 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 ?

Posez votre question
f894009 Messages postés 17206 Date d'inscription dimanche 25 novembre 2007 Statut Membre Dernière intervention 22 novembre 2024 1 710
25 oct. 2018 à 14:01
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???
0
Killermix Messages postés 17 Date d'inscription lundi 16 octobre 2017 Statut Membre Dernière intervention 26 octobre 2018
Modifié le 25 oct. 2018 à 17:17
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.
0
pijaku Messages postés 12263 Date d'inscription jeudi 15 mai 2008 Statut Modérateur Dernière intervention 4 janvier 2024 2 752
25 oct. 2018 à 15:08
0
Killermix Messages postés 17 Date d'inscription lundi 16 octobre 2017 Statut Membre Dernière intervention 26 octobre 2018
25 oct. 2018 à 15:14
Hello,

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