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