Commentaire auto avec historique contenu cellule

Francis

XLDnaute Junior
Bonjour le forum
Je désire insérer un commentaire automatiquement qui me servira d’historique de contenu de cellule. Ce commentaire doit comprendre, la date de modification de cette cellule ainsi que le contenu de la cellule
Grâce au forum, j’ai glané ces quelques lignes qui insèrent la date mais pas le contenu de la cellule.

Private Sub Worksheet_Change(ByVal Target As Excel.Range)
If Not Application.Intersect(Target, Range("D7:G150")) Is Nothing Then
On Error Resume Next
Target.AddComment " Modifié le : " & Format(Now, "dd/mm/yyyy ")
End If
End Sub

Si vous avez une solution, je suis preneur.
Merci beaucoup
Francis
 

pierrejean

XLDnaute Barbatruc
Re : Commentaire auto avec historique contenu cellule

bonjour Francis

Teste

Code:
Private Sub Worksheet_Change(ByVal Target As Excel.Range)
If Not Application.Intersect(Target, Range("D7:G150")) Is Nothing Then
'On Error Resume Next
Target.Comment.Delete
Target.AddComment " Modifié le : " & Format(Now, "dd/mm/yyyy ") & Chr(10) & "contenu= " & Target.Value
End If
End Sub

Attention l'abus de on error resume next est nuisible a l'efficacité
 

Pierrot93

XLDnaute Barbatruc
Re : Commentaire auto avec historique contenu cellule

Bonsoir Francis, PIerreJean:)

c'est fait alors je donne quand même, avec un peu de retard mais bon...

Code:
Private Sub Worksheet_Change(ByVal Target As Excel.Range)
Dim c As Comment
If Not Application.Intersect(Target, Range("D7:G150")) Is Nothing And Target.Count = 1 Then
    Set c = Target.Comment
    If c Is Nothing Then
        Target.AddComment " Modifié le : " & Format(Now, "dd/mm/yyyy hh:nn") & vbLf & _
            Target.Value
    Else
        Target.Comment.Text Target.Comment.Text & vbLf & "Re-modifié le : " & Format(Now, "dd/mm/yyyy hh:nn") & vbLf & _
            Target.Value
    End If
End If
End Sub

bonne soirée
@+
 

Cousinhub

XLDnaute Barbatruc
Re : Commentaire auto avec historique contenu cellule

Bonjour,
salut pierre-jean :)
si tu veux conserver l'historique des valeurs de la cellule :

Code:
Private Sub Worksheet_Change(ByVal Target As Range)
  If Not Application.Intersect(Target, Range("D7:G150")) Is Nothing Then
    If Target.Comment Is Nothing Then Target.AddComment
        With Target.Comment
            .Text Text:=.Text & Target & " Modifié le :" & Format(Now, "dd/mm/yyyy ") & vbLf
            .Visible = True
            .Shape.Select
            Selection.AutoSize = True
            .Visible = False
        End With
   End If
End Sub

Edit : Salut Pierrot, moi aussi, c'était fait.....:D
 

pierrejean

XLDnaute Barbatruc
Re : Commentaire auto avec historique contenu cellule

Re

Salut Pierrot :) :)

il fallait tout de meme gerer l'absence de commentaire au depart donc:

Code:
Private Sub Worksheet_Change(ByVal Target As Excel.Range)
If Not Application.Intersect(Target, Range("A1:A10")) Is Nothing Then
On Error Resume Next
Target.Comment.Delete
On Error GoTo 0
Target.AddComment " Modifié le : " & Format(Now, "dd/mm/yyyy ") & Chr(10) & "contenu= " & Target.Value
End If
End Sub
 

wamme

XLDnaute Occasionnel
Re : Commentaire auto avec historique contenu cellule

Bonsoir
tardif mais j'ai réussi
Edit : tu auras plusieurs versions

Private Sub Worksheet_Change(ByVal Target As Excel.Range)
If Not Application.Intersect(Target, Range("D7:G150")) Is Nothing Then
On Error Resume Next
Temp = Target.Comment.Text
If Err <> 0 Then Target.AddComment
Target.Comment.Text Text:=Target.Comment.Text & Target.Value & " Modifié " & " Le " & Now & Chr(10)
End If
End Sub
 

Pierrot93

XLDnaute Barbatruc
Re : Commentaire auto avec historique contenu cellule

Re, bonsoir bhbh, Wamme

bravo bhbh, beaucoup plus court... la ligne ci dessous doit permettre d'éviter le "select", enfin chez moi "excel2003" :

Code:
           .Shape.DrawingObject.AutoSize = True

pas pu m'empêcher, j'aime pas les select.... lol

bonne soirée à tous
 

lamho27

XLDnaute Occasionnel
Re : Commentaire auto avec historique contenu cellule

bonjour jeanpierre ;
ton code tres bien , mais je voudrais changer text suivant :
bleu : 3% inférieur à la norme
rouge : 3% supérieur à la norme

à vérifier en fin d'équipe si écart important

merci
laurent

aide moi
merci
 

Discussions similaires

Statistiques des forums

Discussions
312 084
Messages
2 085 194
Membres
102 813
dernier inscrit
kaiyi