Appliquer une macro seulement sur certaines colonnes

Bonjour à tous,

Je dispose d'un fichier Excel qui contient une macro.

Cette macro fait en sorte qu'à chaque fois que je modifie une cellule, un commentaire se crée sur la cellule et indique la date de modification et le contenu de la modification.

J'ai réussi à changer cette macro pour que la cellule de droite se modifie et affiche aussi la date de modification.

Cependant, vous devez voir le problème arriver, dès que la cellule de droite se modifie, elle affiche un commentaire et modifie sa cellule de droite et ainsi de suite.

En gros, je voudrais que dès que je modifie F2, un commentaire apparaisse pour F2 la cellule F3 affiche la date, et que ça s'arrête là.

Mais le problème, c'est que dès que je modifie F2, ça modifie F3, qui modifie F4 et ainsi de suite.

Voici la macro en question :

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim strNewText$, strCommentOld$, strCommentNew$
    With Target
        If IsEmpty(Target) Then Exit Sub
        '        If Mid(.Address(1, 1, xlR1C1), 2, InStr(.Address(1, 1, xlR1C1), "C") - 2) > 35 Then Exit Sub
        '        If Right(.Address(1, 1, xlR1C1), Len(.Address(1, 1, xlR1C1)) - InStr(.Address(1, 1, xlR1C1), "C")) < 7 Then Exit Sub
        '        If Right(.Address(1, 1, xlR1C1), Len(.Address(1, 1, xlR1C1)) - InStr(.Address(1, 1, xlR1C1), "C")) > 163 Then Exit Sub
        If .Row = 1 Or .Row > 35 Then Exit Sub
        If .Column < 6 Or .Column > 69 Then Exit Sub
        strNewText = .Text
        If Not .Comment Is Nothing Then
            strCommentOld = .Comment.Text & Chr(10) & Chr(10)
        Else
            strCommentOld = ""
        End If
        On Error Resume Next
        .Comment.Delete
        Err.Clear
        .AddComment
        .Comment.Visible = False
        .Comment.Text Text:=strCommentOld & _
                            Format(VBA.Now, "DD/MM/YYYY à hh:MM ") & Chr(10) & strNewText
        .Comment.Shape.TextFrame.AutoSize = True
        Target.Offset(0, 1) = Now
    End With
End Sub

Or, vu qu'il y a des cellules spécifiques (Les blanches) pour recevoir la date de modification de leurs voisines de gauche, il faudrait que la macro ne s'applique ni à celles-ci, ni aux cellules grises.

Cependant, je n'arrive pas à modifier cette partie de la macro pour qu'elle ne s'applique pas aux cellules <6, 7, 9, 10, 11, 13, 15, 16, 17, 19, 21, 22, 23, 25, 27, 28, 29, 31, 33, 34, 35, 37, 39, 40, 41, 43, 45, 46, 47, 49, 51, 52, 53, 55, 57, 58, 59, 61, 63, 64, 65, 67 et >69

If .Column < 6 Or .Column > 69 Then Exit Sub

Comment puis-je faire pour qu'au lieu que ça s'applique à toutes les colonnes de 6 à 69, ça ne s'applique qu'aux colonnes dont j'ai besoin ?

Bonjour,

Une solution serait de désactiver les évènements par cette instruction, insérée en tout début de code :

Application.EnableEvents = False

Ceci permet de désactiver tous les évènements qui pourraient se produire lors du déroulement de ton code évènementiel.

Et à la fin du code, cette instruction est réactivée automatiquement (=True)

Cependant, même si cela paraît la solution la plus facile, c'est aussi la plus "embêtante"...

En effet, en cas de plantage lors du déroulement du code, l'instruction n'est pas réactivée...

Et donc, sauf si tu mets un "Reset" (soit un nouveau code à déclencher via un bouton), il faut fermer le fichier, puis le rouvrir pour que le déroulement des évènements soit de nouveau opérationnel.

Une solution de contournement est d'utiliser une variable booléenne..

Dans ton projet, tu insères un module, dans lequel tu déclares ta variable :

Public Flag As Boolean

Attention, il faut que cette variable soit bien dans un module standard, et non dans l'évènement de feuille

Et tu modifies ton code ainsi :

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim strNewText$, strCommentOld$, strCommentNew$
    With Target
        If Flag Then Exit Sub 'si la variable est "True", on sort
        Flag = False 'on remet la variable à "False"
        If IsEmpty(Target) Then Exit Sub
        '        If Mid(.Address(1, 1, xlR1C1), 2, InStr(.Address(1, 1, xlR1C1), "C") - 2) > 35 Then Exit Sub
        '        If Right(.Address(1, 1, xlR1C1), Len(.Address(1, 1, xlR1C1)) - InStr(.Address(1, 1, xlR1C1), "C")) < 7 Then Exit Sub
        '        If Right(.Address(1, 1, xlR1C1), Len(.Address(1, 1, xlR1C1)) - InStr(.Address(1, 1, xlR1C1), "C")) > 163 Then Exit Sub
        If .Row = 1 Or .Row > 35 Then Exit Sub
        If .Column < 6 Or .Column > 69 Then Exit Sub
        strNewText = .Text
        If Not .Comment Is Nothing Then
            strCommentOld = .Comment.Text & Chr(10) & Chr(10)
        Else
            strCommentOld = ""
        End If
        On Error Resume Next
        .Comment.Delete
        Err.Clear
        .AddComment
        .Comment.Visible = False
        .Comment.Text Text:=strCommentOld & _
                            Format(VBA.Now, "DD/MM/YYYY à hh:MM ") & Chr(10) & strNewText
        .Comment.Shape.TextFrame.AutoSize = True
        Flag = True 'on met la variable à "True", ainsi dès que la ligne suivante va s'exécuter, on évitera la "boule de neige"...
        Target.Offset(0, 1) = Now
    End With
End Sub

Bon courage

Edit :

En utilisant l'instruction EnableEvents, tu peux quand même faire comme ceci :

Private Sub Worksheet_Change(ByVal Target As Range)

    Dim strNewText$, strCommentOld$, strCommentNew$
    With Target
        If IsEmpty(Target) Then Exit Sub
        '        If Mid(.Address(1, 1, xlR1C1), 2, InStr(.Address(1, 1, xlR1C1), "C") - 2) > 35 Then Exit Sub
        '        If Right(.Address(1, 1, xlR1C1), Len(.Address(1, 1, xlR1C1)) - InStr(.Address(1, 1, xlR1C1), "C")) < 7 Then Exit Sub
        '        If Right(.Address(1, 1, xlR1C1), Len(.Address(1, 1, xlR1C1)) - InStr(.Address(1, 1, xlR1C1), "C")) > 163 Then Exit Sub
        If .Row = 1 Or .Row > 35 Then Exit Sub
        If .Column < 6 Or .Column > 69 Then Exit Sub
        strNewText = .Text
        If Not .Comment Is Nothing Then
            strCommentOld = .Comment.Text & Chr(10) & Chr(10)
        Else
            strCommentOld = ""
        End If
        On Error Resume Next
        .Comment.Delete
        Err.Clear
        .AddComment
        .Comment.Visible = False
        .Comment.Text Text:=strCommentOld & _
                            Format(VBA.Now, "DD/MM/YYYY à hh:MM ") & Chr(10) & strNewText
        .Comment.Shape.TextFrame.AutoSize = True
    Application.EnableEvents = False
    Target.Offset(0, 1) = Now
    Application.EnableEvents = True
    End With
End Sub

Mais comme je l'ai dit plus haut, cette instruction est à prendre avec d'énormes pincettes...

Et en appliquant la macro à seulement une colonne sur deux comme je le disais, c'est pas possible ? Ca empêcherait l'effet boule de neige ^^

Puisque là, si j'ai bien compris, ta solution risque de créer des bugs ?

Bonjour,

Si tu ne veux pas utiliser une des méthodes citées supra (qui fonctionnent quand même), tu peux rajouter cette ligne de condition :

        .....
If .Column < 6 Or .Column > 69 Then Exit Sub
        If .Column Mod 6 <> 0 And (.Column - 2) Mod 6 <> 0 Then Exit Sub ' <<-- celle-ci
....

Bon W-E

Tant que je n'efface pas toutes les cellules en même temps (Ce qui ne m'arrivera pas très souvent), ça marche très bien !

Merci ^^

Re,

Dans ce cas, tu rajoutes une condition :

If Target.Count > 1 Then Exit Sub

Bon W-E