Commentaire évolutif

[Ozons123]

Bonsoir le forum,

petite question sur l'insertion d'un commentaire évolutif. Exemple du code:

Sub Toto()
Range("C4").AddComment
Range("C4").Comment.Visible = True
Range("C4").Comment.Text Text:="Test" & Chr(10) & Range("A1") & Chr(10)
Range("C4").Select
ActiveCell.Comment.Visible = False
End Sub

Après validation d'un bouton intégré au userform =>
- insertion d'un commentaire dans la cellule C4 dont le contenu se trouve en
cellule A1

Question:
Si la cellule A1 évolue comment faire évoluer le commentaire ?

Par avance merci Ozons

 

[SergiO]

Re : Commentaire évolutif

Bonsoir ozons

Essaie avec ceci dans un nouveau code :

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Range("C4").Comment.Text Text:="Test" & Chr(10) & Range("A1") & Chr(10)
End Sub

@+

 

[myDearFriend!]

Re : Commentaire évolutif

Bonsoir Ozons123, SergiO, le Forum,

Une autre façon de voir les choses avec une petite préférence pour l'utilisation de l'évènement Change (au lieu de SelectionChange qui a l'inconvénient majeur de se déclencher lors de chaque changement de sélection et donc souvent à tort...) :

[SIZE=2][COLOR=GRAY][B][I]DANS LE MODULE DE CODE DE LA FEUILLE[/I][/B][/COLOR]

[COLOR=NAVY]Option Explicit[/COLOR]
[COLOR=GREEN]'myDearFriend![/COLOR]
[COLOR=NAVY]Private Sub[/COLOR] Worksheet_Change([COLOR=NAVY]ByVal[/COLOR] Target [COLOR=NAVY]As[/COLOR] Range)
[COLOR=NAVY]Dim[/COLOR] C [COLOR=NAVY]As[/COLOR] Comment
    [COLOR=NAVY]If Not[/COLOR] Application.Intersect(Target, Range("A1")) [COLOR=NAVY]Is Nothing Then
        With[/COLOR] Range("C4")
            [COLOR=NAVY]On Error Resume Next
            Set[/COLOR] C = .Comment
            [COLOR=NAVY]On Error GoTo[/COLOR] 0
            [COLOR=NAVY]If[/COLOR] C [COLOR=NAVY]Is Nothing Then Set[/COLOR] C = .AddComment
        [COLOR=NAVY]End With
        With[/COLOR] Range("A1")
            [COLOR=NAVY]If[/COLOR] .Text <> "" [COLOR=NAVY]Then[/COLOR]
                C.Shape.TextFrame.Characters.Text = .Text
            [COLOR=NAVY]Else[/COLOR]
                C.Delete
            [COLOR=NAVY]End If
        End With
    End If
End Sub[/COLOR][/SIZE]

Ce code devrait fonctionner dès lors où la valeur de A1 n'est pas le résultat d'une formule...

Cordialement,

 

[Ozons123]

Re : Commentaire évolutif

Merci à vous deux pour vos réponses. Sergio cela ne fonctionne pas.
MyDear Friend malheureusement A1 est le résultat d'une formule. JE ne pensais pas que cette information pouvait poser problème. Je vais essayé de comprendre ton code tout de même, cela peut me donner des idées. Merci

BOnne soirée Ozons

 

[myDearFriend!]

Re : Commentaire évolutif

Re Ozons123,

Quels sont les antécédents de la formule en A1 ? (ou plus simplement, quelle est la formule que tu as en A1 ?)

 

[Ozons123]

Re : Commentaire évolutif

IL s'agit de cette formule:

=SI('Gestion Du Risque'!$I17=0;0;SI('Gestion Du Risque'!$J17=0;0;SI('Gestion Du Risque'!$K$9="Option1";'Gestion Du Risque'!$J17-($V5*'Gestion Du Risque'!$J17)/$F5;'Gestion Du Risque'!$J17-($X5*'Gestion Du Risque'!$J17)/$F5)))

Formule qui a oublié de faire une petite cure

@+ Ozons

 

[myDearFriend!]

Re : Commentaire évolutif

Re Re

Quel est le nom de la feuille contenant tes cellules A1 et C4 du départ ?
(sauf erreur ta formule en A1 de cette feuille fait référence à une autre feuille nommée "Gestion Du Risque").
Avec cet élément, je devrais pouvoir te proposer une autre solution mais ça ne pourra fonctionner que si les cellules I17, J17 et K9 de cette feuille "Gestion Du Risque" ne sont pas elles-même des résultats de formules...

 

[Ozons123]

Re : Commentaire évolutif

Pour les cellules A1 et C4 il s'agit de l'onglet DATA. Je vais ensuite adapter ton code, je me refuse de faire un simple copier coller sans en comprendre le sens . Merci pour ton aide.

 

[myDearFriend!]

Re : Commentaire évolutif

Comme j'ai travaillé sur une solution, je me permets quand même de la poster ici... Peut-être cela te dépannera-t'il ou peut-être cela pourra intéresser d'autres ?

J'ai essayé de commenter le code pour tenter d'expliquer la démarche.

Tout d'abord, il convient de supprimer le code cité plus haut, appartenant au module de code de la feuille. Ensuite, il convient de placer le code suivant dans le module de code de l'objet ThisWorkbook :

[SIZE=2][COLOR=GRAY][B][I]DANS LE MODULE DE CODE DE L'OBJET THISWORKBOOK[/I][/B][/COLOR]

[COLOR=NAVY]Option Explicit[/COLOR]
[COLOR=GREEN]'myDearFriend! - 06/11/06[/COLOR]
[COLOR=NAVY]Private Sub[/COLOR] Workbook_SheetChange([COLOR=NAVY]ByVal[/COLOR] Sh [COLOR=NAVY]As Object[/COLOR], [COLOR=NAVY]ByVal[/COLOR] Target [COLOR=NAVY]As[/COLOR] Range)
[COLOR=NAVY]Dim[/COLOR] Plage [COLOR=NAVY]As[/COLOR] Range
[COLOR=NAVY]Dim[/COLOR] C [COLOR=NAVY]As[/COLOR] Comment
    [COLOR=GREEN]'On surveille les antécédents de la formule (situés sur 2 feuilles différentes)[/COLOR]
    [COLOR=NAVY]Select Case[/COLOR] Sh.Name
    [COLOR=NAVY]Case[/COLOR] "DATA"
        [COLOR=NAVY]Set[/COLOR] Plage = Range("F5,V5,X5")
    [COLOR=NAVY]Case[/COLOR] "Gestion Du Risque"
        [COLOR=NAVY]Set[/COLOR] Plage = Range("I17,J17,K9")
    [COLOR=NAVY]Case Else
        Exit Sub
    End Select[/COLOR]
    [COLOR=GREEN]'La modif est recevable pour MAJ du commentaire[/COLOR]
    [COLOR=NAVY]If Not[/COLOR] Application.Intersect(Target, Plage) [COLOR=NAVY]Is Nothing Then[/COLOR]
        [COLOR=GREEN]'Modif du commentaire en C4 = valeur Sheets("DATA").Range("A1")[/COLOR]
        [COLOR=NAVY]With[/COLOR] Sheets("DATA")
            [COLOR=NAVY]With[/COLOR] .Range("C4")
                [COLOR=NAVY]On Error Resume Next
                Set[/COLOR] C = .Comment
                [COLOR=NAVY]On Error GoTo[/COLOR] 0
                [COLOR=GREEN]'Crée le commentaire s'il n'existe pas[/COLOR]
                [COLOR=NAVY]If[/COLOR] C [COLOR=NAVY]Is Nothing Then Set[/COLOR] C = .AddComment
            [COLOR=NAVY]End With[/COLOR]
            [COLOR=GREEN]'MAJ du commentaire[/COLOR]
            [COLOR=NAVY]With[/COLOR] .Range("A1")
                [COLOR=NAVY]If[/COLOR] .Text <> "" [COLOR=NAVY]Then[/COLOR]
                    C.Shape.TextFrame.Characters.Text = .Text
                [COLOR=NAVY]Else[/COLOR]
                    C.Delete
                [COLOR=NAVY]End If
            End With
        End With
    End If
End Sub[/COLOR][/SIZE]

Cordialement,

 

[Ozons123]

Re : Commentaire évolutif

Excellent, un grand merci pour ton aide et tes explications qui m'ont permis de comprendre ton code.

Ozons