Commentaire si présence de formules

DoubleZero · 25 Novembre 2010

Bonjour à toutes et à tous,

J'ai découvert, ici :

https://www.excel-downloads.com/threads/commentaire-conditionnel-help.153611/

le moyen d'insérer un commentaire conditionné par la présence d'un OUI.

Code:

Private Sub Worksheet_Change(ByVal Target As Excel.Range)
If Not Intersect(Target, Range("A:A,C7:AJ7,C18:AJ18,C37:AJ37,C48:AJ48")) Is Nothing Then
If Target = "OUI" Then
With Target
.AddComment
.Comment.Text Text:="Indiquer les références inserts et le bon de commande associé"
End With
End If
End If
End Sub

Merci pour la question et la réponse émises.

Afin de "protéger" certaines cellules de mes divers tableaux (répartis dans différents fichiers), comment pourrais-je, s'il vous plaît, modifier le code susvisé pour que s'affiche le commentaire "Calcul automatique" dans les cellules contenant des formules ?

Mes diverses tentatives n'ont abouti à rien...

Je vous remercie pour votre aide.

tototiti2008 · 25 Novembre 2010

Re : Commentaire si présence de formules

Bonjour DoubleZero,

Le code actuel se fait sur l'évènement Change, ce qui veut dire qu'il faudrait que tu revalides chaque formule... par contre il s'appliquerait aux nouvelles formules tapées.

Est-ce ce que tu veux ?

DoubleZero · 25 Novembre 2010

Re : Commentaire si présence de formules

Merci, tototiti2008, pour le temps que tu m'accordes.

S'il n'y a pas moyen de faire en sorte que cela s'applique aux formules à la fois anciennement et nouvellement tapées, c'est dommage mais pas grave du tout.

Ce qu'il te sera permis de concocter fera certainement mon bonheur 😀 !

Guest · 25 Novembre 2010

Re : Commentaire si présence de formules

Bonjour,

Hello totoTiti🙂

Avec le code ci-dessous placé dans le module de code d'une feuille, dès qu'une forumule sera saisie dans une cellule, un commentaire sera ajouté.

Code:

[COLOR=blue]Private[/COLOR] [COLOR=blue]Sub[/COLOR] Worksheet_Change([COLOR=blue]ByVal[/COLOR] Target [COLOR=blue]As[/COLOR] Excel.Range)
    [COLOR=blue]If[/COLOR] Target.Cells.Count > 1 [COLOR=blue]Then[/COLOR] [COLOR=blue]Exit[/COLOR] [COLOR=blue]Sub[/COLOR]
    [COLOR=blue]With[/COLOR] Target
        [COLOR=blue]If[/COLOR] .HasFormula [COLOR=blue]Then[/COLOR]
            [COLOR=blue]Dim[/COLOR] txt
            [COLOR=blue]If[/COLOR] .Comment [COLOR=blue]Is[/COLOR] [COLOR=blue]Nothing[/COLOR] [COLOR=blue]Then[/COLOR] .AddComment
            [COLOR=green]'Retient le texte existant éventuellement[/COLOR]
            txt = .Comment.Text
            [COLOR=green]'S'il est de longueur nulle [COLOR=blue]on[/COLOR] ajoute le commentaire[/COLOR]
            [COLOR=blue]If[/COLOR] Len(txt) = 0 [COLOR=blue]Then[/COLOR]
                txt = [I]"Calcul par formule (automatique)"[/I]
            [COLOR=blue]Else[/COLOR]
                [COLOR=green]'Sinon [COLOR=blue]on[/COLOR] vérifie que le message n'existe pas avant de l'ajouter[/COLOR]
                [COLOR=blue]If[/COLOR] InStr(1, .Comment.Text, [I]"Calcul par formule (automatique)"[/I]) = 0 [COLOR=blue]Then[/COLOR]
                    txt = txt & Chr(10) & [I]"Calcul par formule (automatique)"[/I]
                [COLOR=blue]End[/COLOR] [COLOR=blue]If[/COLOR]
            [COLOR=blue]End[/COLOR] [COLOR=blue]If[/COLOR]
            [COLOR=green]' réinjecte le commentaire[/COLOR]
            .Comment.Text Text:=txt
        [COLOR=blue]End[/COLOR] [COLOR=blue]If[/COLOR]
    [COLOR=blue]End[/COLOR] [COLOR=blue]With[/COLOR]
[COLOR=blue]End[/COLOR] [COLOR=blue]Sub[/COLOR]

La procédure ci-dessous parcours toutes les cellules qui ont une formule de toute les feuilles du classeur et insère éventuellement le commentaire. (non testée)

Code:

[COLOR=BLUE]Sub[/COLOR] Inserercommentaire()
    [COLOR=BLUE]Dim[/COLOR] c [COLOR=BLUE]As[/COLOR] Range, plg [COLOR=BLUE]As[/COLOR] Range
    [COLOR=BLUE]Dim[/COLOR] sh [COLOR=BLUE]As[/COLOR] Worksheet
    [COLOR=BLUE]For[/COLOR] [COLOR=BLUE]Each[/COLOR] sh [COLOR=BLUE]In[/COLOR] ActiveWorkbook
        [COLOR=BLUE]On[/COLOR] [COLOR=BLUE]Error[/COLOR] [COLOR=BLUE]Resume[/COLOR] [COLOR=BLUE]Next[/COLOR]
        [COLOR=BLUE]Set[/COLOR] plg = sh.UsedRange.SpecialCells(xlCellTypeFormulas)
        [COLOR=BLUE]If[/COLOR] [COLOR=BLUE]Not[/COLOR] plg [COLOR=BLUE]Is[/COLOR] [COLOR=BLUE]Nothing[/COLOR] [COLOR=BLUE]Then[/COLOR]
            [COLOR=BLUE]For[/COLOR] [COLOR=BLUE]Each[/COLOR] c [COLOR=BLUE]In[/COLOR] plg.Cells
                [COLOR=BLUE]With[/COLOR] c
                    [COLOR=BLUE]Dim[/COLOR] txt
                    [COLOR=BLUE]If[/COLOR] .Comment [COLOR=BLUE]Is[/COLOR] [COLOR=BLUE]Nothing[/COLOR] [COLOR=BLUE]Then[/COLOR] .AddComment
                    [COLOR=GREEN]'Retient le texte existant éventuellement[/COLOR]
                    txt = .Comment.Text
                    [COLOR=GREEN]'S'il est de longueur nulle [COLOR=BLUE]on[/COLOR] ajoute le commentaire[/COLOR]
                    [COLOR=BLUE]If[/COLOR] Len(txt) = 0 [COLOR=BLUE]Then[/COLOR]
                        txt = [i]"Calcul par formule (automatique)"[/i]
                    [COLOR=BLUE]Else[/COLOR]
                        [COLOR=GREEN]'Sinon [COLOR=BLUE]on[/COLOR] vérifie que le message n'existe pas avant de l'ajouter[/COLOR]
                        [COLOR=BLUE]If[/COLOR] InStr(1, .Comment.Text, [i]"Calcul par formule (automatique)"[/i]) = 0 [COLOR=BLUE]Then[/COLOR]
                            txt = txt & Chr(10) & [i]"Calcul par formule (automatique)"[/i]
                        [COLOR=BLUE]End[/COLOR] [COLOR=BLUE]If[/COLOR]
                    [COLOR=BLUE]End[/COLOR] [COLOR=BLUE]If[/COLOR]
                    [COLOR=GREEN]' réinjecte le commentaire[/COLOR]
                    .Comment.Text Text:=txt
                [COLOR=BLUE]End[/COLOR] [COLOR=BLUE]With[/COLOR]
            [COLOR=BLUE]Next[/COLOR] c
        [COLOR=BLUE]End[/COLOR] [COLOR=BLUE]If[/COLOR]
    [COLOR=BLUE]Next[/COLOR] sh
[COLOR=BLUE]End[/COLOR] [COLOR=BLUE]Sub[/COLOR]

A+

James007 · 25 Novembre 2010

Re : Commentaire si présence de formules

Bonjour à tous ...🙂

Pour "rattraper" les anciennes cellules ... les sélectionner une fois ...

Code:

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Target.Count > 1 Then Exit Sub
If Target.HasFormula = True And Target.Comment Is Nothing Then
With Target
    .AddComment
    .Comment.Text Text:="Calcul Automatique"
End With
End If
End Sub

A +

DoubleZero · 25 Novembre 2010

Re : Commentaire si présence de formules

Re-bonjour,

MAGNIFIQUE !

Mille fois merci, Hasco, pour le temps accordé, le travail fourni, la peine à commenter les diverses lignes du code et le résultat offert.

Bon après-midi.

PS : je découvre la seconde macro qui affiche "erreur d'exécution 438" sur "For Each sh In ActiveWorkbook" (?).
Ce n'est pas grave, la première macro répond à mes attentes ! Encore MERCI...

tototiti2008 · 25 Novembre 2010

Re : Commentaire si présence de formules

Bonjour Hasco, James,
Re,

dans le 2ème code de Hasco, remplace

Code:

[I]For Each sh In ActiveWorkbook[/I]

par

Code:

[I]For Each sh In ActiveWorkbook.Worksheets[/I]

DoubleZero · 25 Novembre 2010

Re : Commentaire si présence de formules

Re-bonjour à toutes et à tous,

Qui ose penser et dire que le Père Noël n’existe pas ???

Un grand et chaleureux MERCI à :

- tototiti2008 😀 ;
- Hasco 😀 ;
- James007😀.

Guest · 25 Novembre 2010

Re : Commentaire si présence de formules

Re,

A moi de dire merci à Tototiti😀 pour avoir corrigé mon oubli, pendant que je ramassais les feuilles dans le jardin.

C'est chouette la collaboration xldienne.

A+

DoubleZero · 25 Novembre 2010

Re : Commentaire si présence de formules

Hasco à dit:
C'est chouette la collaboration xldienne

C'est chouette et formidable !

Commentaire si présence de formules

DoubleZero

XLDnaute Barbatruc

tototiti2008

XLDnaute Barbatruc

DoubleZero

XLDnaute Barbatruc

Guest

Guest

James007

XLDnaute Barbatruc

DoubleZero

XLDnaute Barbatruc

tototiti2008

XLDnaute Barbatruc

DoubleZero

XLDnaute Barbatruc

Guest

Guest

DoubleZero

XLDnaute Barbatruc

Discussions similaires

Commentaire si présence de formules

XLDnaute Barbatruc

XLDnaute Barbatruc

XLDnaute Barbatruc

Guest

Guest

XLDnaute Barbatruc

XLDnaute Barbatruc

XLDnaute Barbatruc

XLDnaute Barbatruc

Guest

Guest

XLDnaute Barbatruc

Discussions similaires

Privacy & Transparency

Privacy & Transparency