Comment détecter l'ajout d'un commentaire ou d'une note
Bonjour,
Connaissez-vous un moyen pour intercepter l'ajout et la modification d'une note car il semblerait qu'il n'existe pas d'évènement particulier rattaché à la création d'une note.
Mon besoin serait de faire suivre une note qui vient d'être créée dans une feuille sur les feuilles suivantes.
Exemple : sur la feuille 1 une note est ajoutée en A5, aussitôt je la duplique en A5 sur les feuilles 2,3....13
Si cette note est ensuite modifiée sur la feuille 7, aussitôt elle est dupliquée sur les feuilles 8,9...13 laissant les notes des feuilles 1,2...7 inchangées.
J'avais pensé me sortir d'affaire avec le petit code suivant mais je viens de m'apercevoir que bien qu'il fonctionne à peut prêt il ne correspond pas vraiment à mes attentes car si j'active une des feuilles précédent la feuille 7, ce code se lancera de nouveau et écrasera les modifications apportés dans la cellule A5 des feuilles 7,8,9...13 alors que je voudrais que ça ne se fasse que si c'est une nouvelle note qui est ajoutée ou si une note est modifiée mais pas systématiquement quand j'active une feuille.
Si vous avez une idée pour contourner ce problème, je suis preneur :)
Code:
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
| Private Sub Worksheet_Activate()
Dim Ind, F, N As Integer
Application.EnableEvents = False
Application.ScreenUpdating = False
'Copier-coller toutes les Notes rattachées aux cellules A3 à A49 de la feuille précédente
'sur l'ensembles des 12 feuilles suivantes
'Vérifier que l'index de la feuille active soit compris entre 2 et 13
If ActiveSheet.Index > 1 And ActiveSheet.Index < 14 Then
'récupère l'index de la feuille active
Ind = ActiveSheet.Index
'Passe en revue chaque cellule comprise entre A3 et A49 sur la feuille précédente
For N = 3 To 49
'test si cette cellule est vide
If Sheets(Ind - 1).Cells(N, 1).Value <> "" Then
'vérifier si un commentaire est rattaché à cette cellule
If Not Sheets(Ind - 1).Cells(N, 1).Comment Is Nothing Then
'copier le commentaire
Sheets(Ind - 1).Cells(N, 1).Copy
'Coller ce commentaire sur chacune des feuilles suivantes jusqu'à la feuille 13 maxi
For F = Ind To 13
Sheets(F).Activate
Sheets(F).Cells(N, 1).PasteSpecial Paste:=xlPasteComments, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
Next F
End If
Else
'on sort de la boucle dès la 1ere cellule vide car les autres cellules en dessous sont forcement vide
Exit For
End If
Next N
'Revenir sur la feuille de départ
Sheets(Ind).Activate
End If
Application.EnableEvents = True
Application.ScreenUpdating = True
End Sub |
