Macro

Résolu
Luni -  
 Luni -
Bonjour à tous ! :-)

J'ai une demande un peu particulière et j'espère sincèrement trouvé une bonne âme qui pourra m'aider.

J'ai des données d'exploitation de D9 à I800. Serait-il possible de faire en sorte que si les données sont modifiées elles apparaissent en rouge et que les anciennes soient mises sous forme de commentaire dans la cellule correspondante ?

Merci infiniment pour votre aide :-)))))



A voir également:

4 réponses

michel_m Messages postés 16602 Date d'inscription   Statut Contributeur Dernière intervention   3 313
 
en définitive c'est bourré de pièges comme je le pressenais post 7

à tester encore:
http://www.cjoint.com/c/FJqp3z2yULh
1
Luni
 
Suppppppppppppppperbeeee ! Merci énormément pour ta patience et ton investissement. Ça va vraiment bcp m'aider. :-))))
0
Luni
 
Je viens de voir juste un petit souci la macro fonctionne parfaitement mais lorsque je sélectionne des cellules (sans cliquer dessus) et même en dehors du tableau il m'indique une erreur dans cette ligne ?

If Not Intersect(Target, Range("B2:D11")) Is Nothing And Target <> "" Then
0
Utilisateur anonyme > Luni
 
 
À tout hasard, et sans aucune garantie, essaye avec (et sur une seule ligne) :

If Not Intersect(Target, Range("B2:D11")) Is Nothing And Not IsEmpty(Target) Then
 
0
Luni > Utilisateur anonyme
 
Ca marche, merci beaucoup albkan :-) ;-)
0
michel_m Messages postés 16602 Date d'inscription   Statut Contributeur Dernière intervention   3 313
 
Bonjour

un exemple
http://www.cjoint.com/c/FJpoeU4Pf7h
pour voir le code
clic droit sur l'onglet de la feuille
visualiser le code

j'ai mis la couleur en jaune pour voir le petit coin rouge signalant un commentaire

edit 16:11
heu dans la macro worksheet_change ajoute juste avant End if
Application.DisplayCommentIndicator = xlCommentIndicatorOnly


bon ! par prudence,les codes...
Option Explicit
Public ad_old As String, Old As Variant
'--------------------------
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Not Intersect(Target, Range("B2:D11")) Is Nothing Then
ad_old = Target.Address
Old = Target
End If
End Sub
'-------------------------------------------
Private Sub Worksheet_Change(ByVal Target As Range)
If ad_old = Target.Address Then
With Range(ad_old)
.AddComment
.Comment.Visible = True
.Comment.Text Old
.Interior.ColorIndex = 6
Range("A1").Select
End With

Application.DisplayCommentIndicator = xlCommentIndicatorOnly
End If
End Sub

 Michel
0
Luni
 
Un génie ! Superbe :-)))) Petite question au cas où une personne se trompe Est-ce qu'il est possible de trouver une touche raccourci pour annuler l'opération ? ;-) ou autres ?
0
michel_m Messages postés 16602 Date d'inscription   Statut Contributeur Dernière intervention   3 313
 
merci,

Il y a peut-^tre une solution : je regarde dès que possible
0
Luni
 
Superbe, merci encore infiniment :-))))
0
Luni
 
En attendant je vais le mettre sur mon tableau :-)
0
michel_m Messages postés 16602 Date d'inscription   Statut Contributeur Dernière intervention   3 313 > Luni
 
proposition à tester
je n'ai pas tester d'éventuels pièges...car j'ai droit au top "one" de la chorale occitane: "chuis pas mariée à un ordinateur!"

déclenchement par clic droit dans la cellule "coupable"
l'annulation peut être faite le classeur ayant été sauvegardé et fermé

Option Explicit
Public ad_old As String, Old As Variant
'--------------------------
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Not Intersect(Target, Range("B2:D11")) Is Nothing Then
ad_old = Target.Address
Old = Target
End If
End Sub
'-------------------------------------------
Private Sub Worksheet_Change(ByVal Target As Range)
If ad_old = Target.Address Then
With Range(ad_old)
On Error GoTo fin
.AddComment
.Comment.Visible = True
.Comment.Text Old & Chr(10) & "Si erreur--> clic droit"
.Interior.ColorIndex = 6
Range("A1").Select
End With
Application.DisplayCommentIndicator = xlCommentIndicatorOnly

'inscrit l'ancienne valeur et son adresse dans la base de registre
SaveSetting appname:="demo", section:="linu", Key:="erreur", setting:=Old
SaveSetting appname:="demo", section:="linu", Key:="lieu", setting:=ad_old
End If
fin:
End Sub
'------------------------------------------------------------
Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean)
Dim retour As String

'adresse inscrite dans la base de registre
retour = GetSetting(appname:="demo", section:="linu", Key:="lieu")
If retour = Target.Address Then

'donnée inscrite dans la base de registre
Target = GetSetting(appname:="demo", section:="linu", Key:="erreur")
Target.Interior.ColorIndex = -4142
Range(retour).ClearComments
End If

Range("A1").Select
End Sub

tu dis
0
Luni
 
:-. Oui ca fonctionne super bien ! :-) Mais en le mettant sur mon fichier il y a un petit bug je crois que c'est parce que dans certaines cellules il y a des heures et je crois qu'il aime pas ca! Est-ce que c'est grave docteur !? ;-) Excuse j'aurais peut-être du le préciser dès le départ !? :-(
0
michel_m Messages postés 16602 Date d'inscription   Statut Contributeur Dernière intervention   3 313 > Luni
 
Bonjour,

je viens d'essayer par ex: 12:45 ou 3:00 et ca marche... ?
http://www.cjoint.com/c/FJqgaazPMZh

Par contre, que fait on avec une cellule vide? au départ, quand tu remplis le tableau vide cellule par cellule, la valeur inscrite fait passer la cellule en jaune avec commentaire.
il faudrait peut-^tre faire une macro "préparer"qui effacerait les couleurs et les commentaires

D'autre part:
1/ worksheet_change ne fonctionne que sur des saisies. Donc si ton tableau est issu de formules, celle-ci seront détruites.
2/ l'astuce de la base de registre n'est valable que sur monoposte. si le classeur est sur serveur, cela ne marche pas

tu dis...
0