Commentaires dynamiques

[Nit06]

Un grand boujour à tout le forum.
J'ai une feuille s'appelant 'Organigramme' avec des commentaires. Ces commentaires incluent des contenus de cellules se trouvant sur la feuille 'Données'. Ces contenus varient en fonction de la plage decellules A1:A4 de la feuille 'Organigramme'. Ce que je souhaite faire, c'est actualiser automatiquement tous les commentaires dès qu'il y a un changement de valeur dans la plage A1:A4, récupérant ainsi dans les commentaires les valeurs recalculées dans la feuille 'Données'. J'espère être assez clair. ci dessous mon code qui bloque dès le première ligne....
:S

Private Sub worksheet_change(target As Range)
If Intersect(target, Range('A1:A4')) Is Nothing Then Exit Sub
Dim c As Comment
Dim ws As Worksheet

Set ws = Sheets('Données')

For Each c In ActiveSheet.Comments
Select Case c.Parent.Address(0, 0)
Case 'B5': c.Text Chr(10) & 'Effectif moyen : ' & ws.Range('a1') & Chr(10) & 'Ancienneté moyenne : ' & ws.Range('a2') & Chr(10) & 'Points : ' & ws.Range('a3') & Chr(10) & 'Points en % total : ' & ws.Range('a4') & ' %' & Chr(10) & 'Heures sup. : ' & ws.Range('a5') & ' h.' & Chr(10) & 'Coûts : ' & ws.Range('a6') & ' €' & Chr(10) & 'Coûts en % total : ' & ws.Range('a7') & ' %'
Case 'B6': c.Text 'CA= ' & ws.Range('b1') & Chr(10) & 'MG= ' & ws.Range('b2')
Case Else: c.Text c.Parent.Text
End Select
Next c

End Sub


Merci d'avnace de votre pateince et de votre aide.

 

[Bernard_XLD]

Bonjour nit06

J'ai repris un peu ton code

Cordialement, A+

Private Sub Worksheet_Change(ByVal Target As Range)
    If Intersect(Target, Range('A1:A4')) Is Nothing Then Exit Sub
    Dim c As Comment
    Dim ws As Worksheet
    Set ws = ThisWorkbook.Sheets('Données')
    With ActiveSheet
    For Each c In .Comments
        Select Case c.Parent.Address
            Case Is = .Range('B5').Address
                With .Range('B5')
                    .ClearComments
                    .AddComment.Text 'Effectif moyen : ' & ws.Range('A1') & Chr(10) & 'Ancienneté moyenne : ' _
                    & ws.Range('A2') & Chr(10) & 'Points : ' & ws.Range('A3') & Chr(10) & 'Points en % total : ' _
                    & ws.Range('A4') & ' %' & Chr(10) & 'Heures sup. : ' & ws.Range('A5') & ' h.' & Chr(10) & _
                    'Coûts : ' & ws.Range('A6') & ' ¬' & Chr(10) & 'Coûts en % total : ' & ws.Range('A7') & ' %'
                End With
            Case Is = Range('B6').Address
                With .Range('B5')
                    .ClearComments
                    .AddComment.Text 'CA= ' & ws.Range('B1') & Chr(10) & 'MG= ' & ws.Range('B2')
                End With
            Case Else
                With .Range(c.Parent.Address)
                    .ClearComments
                    .AddComment.Text c.Parent.Value
                End With
            End Select
        Next c
    End With
End Sub

 

[Nit06]

Un grand merci miaou à toi pour ta précieuse aide et vivement la mi aout 🙂

Je vais essayer de comprendre tes corrections. bonne soirée