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 : Sélectionner tout - Visualiser dans une fenêtre à part
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
Partager