récupérer les différents commentaires de cellules Dans un commentaire d’une cellul

[Chri8Ed]

Bonjour à tous



Je souhaiterais pour récupérer les différents commentaires des cellules d’une même ligne
Dans un commentaire d’une cellule.

(13 au maximum, mais en pratique 7 ou 8 au grand maximum)
(La ligne cependant comporte bien 13 cellules)

Exemple B1 récupère les éventuelles commentaires des cellules J1 à V1
Et ceux-ci viennent se placer à la ligne

Sans doute un peu compliqué à comprendre, je mets donc un tableau en exemple

Il faudra probablement une boucle
Mais le plus difficile sera sans doute de mettre les différents commentaires à la ligne des uns des autres ??

Je n’arrive pas à trouver
Si c’est réalisable et que quelqu’un voit une solution

Merci par avance

 

[job75]

Bonjour Chri8Ed,

Sub ConcatComments()
Dim P As Range, ncol%, i&, t$, j%, n&
With Sheets("Feuil1")
    Set P = Intersect(.UsedRange, .[J:V])
End With
If P Is Nothing Then Exit Sub
ncol = P.Columns.Count
For i = 1 To P.Rows.Count
    t = "" 'RAZ
    For j = 1 To ncol
        If Not P(i, j).Comment Is Nothing Then t = t & vbLf & P(i, j).Comment.Text
    Next j
    With P(i, 1).EntireRow.Cells(2) 'en colonne B
        .ClearContents: .ClearComments
        If t <> "" Then
            n = n + 1
            .Value = "Comment" & n
            .AddComment(Mid(t, 2)).Shape.TextFrame.AutoSize = True
        End If
    End With
Next i
End Sub

A+

 

[Chri8Ed]

Bonjour et merci Job
Je suis en train de tester
C'est exactement ce que je souhaitais
Je constate cependant une anomalie sur certaines lignes
Sur l'exemple 2 notamment
Mais cela se reproduit sur des nouvelles lignes que j'ai ajoutées pour le vérifier
Les commentaires sont espacés d'une ligne vide ?
Pour l'instant je n'en vois pas la cause ?
Sinon c'est parfait
A+

 

[job75]

Re,

Il est facile de voir que les espacements dans le commentaire de B11 sont dus à des renvois à la ligne dans les commentaires de K11 et M11.

Ils y ont été mis manuellement alors retirez-les manuellement.

En ce qui concerne la durée d'exécution la macro précédente s'exécute chez moi en 0,15 seconde.

Celle-ci s'exécute en 0,013 seconde :

Sub ConcatComments()
Dim P As Range, ncol%, i&, t$, j%, n&
Application.ScreenUpdating = False
With Sheets("Feuil1")
    Set P = Intersect(.UsedRange, .[J:V])
    If P Is Nothing Then Exit Sub
    With Intersect(P.EntireRow, .[B:B])
        .ClearContents: .ClearComments 'RAZ
    End With
End With
ncol = P.Columns.Count
For i = 1 To P.Rows.Count
    t = "" 'RAZ
    For j = 1 To ncol
        If Not P(i, j).Comment Is Nothing Then t = t & vbLf & P(i, j).Comment.Text
    Next j
    With P(i, 1).EntireRow.Cells(2) 'en colonne B
        If t <> "" Then
            n = n + 1
            .Value = "Comment" & n
            .AddComment(Mid(t, 2)).Shape.TextFrame.AutoSize = True
        End If
    End With
Next i
End Sub

A+

 

[Chri8Ed]

Bonjour Job, Bonjour à tous

Excuse moi, je ne m'étais pas aperçu que j'avais mis des retours à la ligne dans certains commentaires dans cet exemple
Car en réalité, je n'en mets aucun

Question temps
Je l'ai intégré dans mon fichier
Il comporte plus de 2000 lignes et il faut 43 secondes
étant donné que je ne l’utiliserai que en cas de modification ou d'ajout
Cela reste très acceptable

Il s'agit pour moi de certaine nouvelles propriétés
tel que : Set P = Intersect(.UsedRange, .[J:V])
et : .AddComment(Mid(t, 2)).Shape.TextFrame.AutoSize = True
Du coup je me suis servi de F1
Mais j'ai du mal à tout assimilé

Je souhaité paramétré la taille et la police, ainsi que la couleur du fond
Je devrai logiquement l'intégré en dessous de "AddComment(Mid(t, 2)).Shape.TextFrame.AutoSize = True"
En tout cas dans le même "with"
Mais je ne vois pas comment faire

a+

 

[job75]

Bonjour Chri8Ed,

Ceci met en forme les commentaires créés :

Sub ConcatComments()
Dim P As Range, ncol%, i&, t$, j%, n&
Application.ScreenUpdating = False
With Sheets("Feuil1")
    Set P = Intersect(.UsedRange, .[J:V])
    If P Is Nothing Then Exit Sub
    With Intersect(P.EntireRow, .[B:B])
        .ClearContents: .ClearComments 'RAZ
    End With
End With
ncol = P.Columns.Count
For i = 1 To P.Rows.Count
    t = "" 'RAZ
    For j = 1 To ncol
        If Not P(i, j).Comment Is Nothing Then t = t & vbLf & P(i, j).Comment.Text
    Next j
    With P(i, 1).EntireRow.Cells(2) 'en colonne B
        If t <> "" Then
            n = n + 1
            .Value = "Comment" & n
            With .AddComment(Mid(t, 2)).Shape
                .Fill.ForeColor.RGB = RGB(0, 112, 192) 'remplissage bleu
                With .TextFrame.Characters.Font
                    .Size = 14 'taille de la police
                    .Bold = True 'gras
                    .ColorIndex = 2 'blanc
                End With
                .TextFrame.AutoSize = True
            End With
        End If
    End With
Next i
End Sub

A+

 

[Chri8Ed]

Re,
Cette nouvelle version semble très bien répondre à mon souhait de mise en forme
Mais je m'étais attaché uniquement au résultat des commentaires
Du coup je n'avais pas fait attention
Mais il y a un très gros problème !
C'est que les intitulés dans la colonne B
Sont tous écrasés et prennent à la place les intitulés Comment1, Comment2 et ainsi de suite .....

A+

 

[job75]

Re,

Mais il y a un très gros problème !
C'est que les intitulés dans la colonne B
Sont tous écrasés et prennent à la place les intitulés Comment1, Comment2 et ainsi de suite .....

Oh mon Dieu... Faites une prière, lisez bien le code et je suis sûr que vous arriverez à éviter ça

A+

 

[Chri8Ed]

Re,
Et bien je n'ai pas eu besoin de faire de prièrej
j'ai pensé que ma demande avait sans soute été mal comprise
Et que le code ne pouvait en conséquence ne pas correspondre
A tord !
Merci encore et bonne soirée
A+