Add comment variable

Bonjour Forum,

J'ai une liste d'employé sur une feuille et une base de donnée dans une autre,
Je voudrais ajouter un comment à chaque employé qui liste l'ensemble des projets liée a cet employé (Voir fichier exemple)

Merci!

Bonjour

Ci dessous un code qui fait cela

Code:

---

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 44 45 46 47

Sub Comment() On Error GoTo Gerreur   Dim rg As Range Dim i As Long Dim strComment As String Dim shCible As Worksheet Dim strAddresse As String   Set shCible = ThisWorkbook.Worksheets("Feuil2")   For i = 2 To Me.Range("A65536").End(xlUp).Row strComment = "" 'Cherche les projets Set rg = shCible.Range("D:D").Find(What:=Range("A" & i).Value, lookat:=xlWhole)   If Not rg Is Nothing Then strAddresse = rg.Address   Do   If strComment <> "" Then strComment = strComment & Chr(10) strComment = strComment & shCible.Range("A" & rg.Row).Value & " / " & shCible.Range("K" & i).Value   Set rg = shCible.Range("D:D").FindNext(rg)   Loop While Not rg Is Nothing And rg.Address <> strAddresse     End If   'Ajoute le commentaire   On Error Resume Next Me.Range("A" & i).Comment.Delete On Error GoTo Gerreur   Me.Range("A" & i).AddComment Me.Range("A" & i).Comment.Text Text:=strComment   Next i   Exit Sub Gerreur: MsgBox Err.Number & " : " & Err.Description   End Sub

---

C,est bon ça fonctionne bien merci,

Je voudrais également agrandir ma boite de comment j'ai essayer avec ceci:

Code:

---

.Range("A" & i).ShapeRange.ScaleWidth 1.42, msoFalse, msoScaleFromTopLeft

---

Je me suis servi de l'enregistreur de macro, mais cette méthode me renvoie une erreur : 483

Merci

Comme cela

Code:

---

1 2 3

Me.Range("A" & i).AddComment Me.Range("A" & i).Comment.Shape.ScaleWidth 1.42, msoFalse, msoScaleFromTopLeft Me.Range("A" & i).Comment.Text Text:=strComment

---

Parfait Merci!!