Discussion :

[Beaudelicius]

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!

[jfontaine]

Bonjour

Ci dessous un code qui fait cela

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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

[Beaudelicius]

C,est bon ça fonctionne bien merci,

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

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

.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

[jfontaine]

Comme cela

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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

[Beaudelicius]

Parfait Merci!!