Extraire les commentaires de toutes les feuilles

Bonjour à tous, j'en appel encore à votre communauté pour m'aider à résoudre un problème,

Je n'arrive pas à extraire les commentaires de plusieurs feuilles.

Le code ci dessous fonctionne parfaitement sur une feuille mais je n'arrive pas à l'adapter pour extraire l'ensemble des commentaires entre les feuilles "début" et "fin" sur la plage A4 à dernière ligne non vide de chaque feuille.

Sub test2()

For Each c In Worksheets("Feuil1").UsedRange

If Not c.Comment Is Nothing Then

Worksheets("Feuil2").Cells(i + 1, 1) = c.Comment.Text

i = i + 1

End If

Next c

Worksheets("Feuil2").Cells.WrapText = False

End Sub

Merci d'avance pour votre aide

Salut pic,

comme ca peut être (code non tester)

Sub test2()
Dim ws As Worksheet
For Each ws In ActiveWorkbook.Worksheets
 If ws.Name <> "Feuil2" Then
    For Each c In ws.UsedRange
        If Not c.Comment Is Nothing Then
        Worksheets("Feuil2").Cells(i + 1, 1) = c.Comment.Text
        i = i + 1
        End If
    Next c
 Worksheets("Feuil2").Cells.WrapText = False
 End If
Next ws
End Sub

Merci pour la rapidité de ta réponse!

A priori ton code marche mais il faut que je travail mon fichier car sous excel 2019 les commentaires sont géré différemment que sur les autres versions, du coup seul les notes sont prise en compte et pas les commentaires .

Je souhaiterais aussi rajouter 2 conditions au code, peux tu m'expliquer comment les intégrer:

• condition 1: plage de cellules où faire la recherche (de A7:U200), toute les feuilles sont identique
• condition 2: ne rechercher les commentaire que pour les cellules contenant "test"

Merci pour ton aide

Bonjour pic84, le forum,

Salut m3ellem1,

Je souhaiterais aussi rajouter 2 conditions au code, peux tu m'expliquer comment les intégrer:

• condition 1: plage de cellules où faire la recherche (de A7:U200), toute les feuilles sont identique
• condition 2: ne rechercher les commentaire que pour les cellules contenant "test"

A tester.....

Sub test2()
 Dim ws As Worksheet

 Application.ScreenUpdating = False

  For Each ws In ActiveWorkbook.Worksheets
   If ws.Name <> "Feuil2" Then
    For Each c In ws.Range("A7:U200")
     If c.Value = "test" And Not c.Comment Is Nothing Then
        Worksheets("Feuil2").Cells(i + 1, 1) = c.Comment.Text
        i = i + 1
     End If
    Next c
   Worksheets("Feuil2").Cells.WrapText = False
  End If
 Next ws
End Sub

Cordialement,

Bonjour et merci, j'ai un bug sur cette ligne de code et je n'arrive pas à voir d'ou ça peut venir:

If c.Value = "test" And Not c.Comment Is Nothing Then

erreur d'exécution'13': incompatibilité de type

merci

Re,

Testes ce fichier.....je n'ai pas d'erreur....

Cordialement,

Bonjour xorsankukai et désolé de te répondre si tard.

J'ai essayé ta macro sur d'autres version excel et à chaque fois j'ai le même message d'erreur qui apparaît, ce que je ne comprend pas c'est que lorsque je reviens sur la feuille la macro c'est exécuté correctement....

Cordialement

Bonjour pic84, le forum,

Désolé, je ne vois pas non plus pourquoi...mais nos versions d'excel étant différentes...

Si la macro semble faire le job, on peut essayer de contourner l'erreur...sans conviction....

Sub test2()
 Dim ws As Worksheet
 Dim c As Range, i As Integer

 Application.ScreenUpdating = False

      Sheets("Feuil2").Range("A:A").ClearContents

  For Each ws In ThisWorkbook.Worksheets
   If ws.Name <> "Feuil2" Then
    For Each c In ws.Range("A7:U200")
     On Error Resume Next
      If c.Value = "test" And Not c.Comment Is Nothing Then
       Sheets("Feuil2").Cells(i + 1, 1) = c.Comment.Text
       i = i + 1
      End If
    Next c
   End If
  Next ws

     Sheets("Feuil2").Activate
     Sheets("Feuil2").Cells.WrapText = False
End Sub

m3ellem1 aura peut-être plus de réussite que moi, sinon, si un pro passe dans le coin....

Cordialement,

Bonjour à tous,

Pour info. :

Option Explicit
'old comments
Sub test_Comment()
Dim cmt As Comment
    With ActiveSheet
        For Each cmt In .Comments
            MsgBox cmt.Text
        Next cmt
    End With
End Sub
'new comments
Sub test_CommentThreaded()
Dim cmt As CommentThreaded
    With ActiveSheet
        For Each cmt In .CommentsThreaded
            MsgBox cmt.Text
        Next cmt
    End With
End Sub

Ces nouveaux commentaires sont apparus avec Excel 365 (quelle version ?) et 2019...

https://docs.microsoft.com/en-us/office/vba/api/excel.commentsthreaded

https://docs.microsoft.com/en-us/office/vba/api/excel.commentthreaded

Bonjour Jean-Eric,

Merci pour l'info.

Du coup faut-il remplacer

 If c.Value = "test" And Not c.Comment Is Nothing Then

par

 If c.Value = "test" And Not c.CommentsThreaded Is Nothing Then

??

Amitiés,

Re,

Oui, mais

If c.Value = "test" And Not c.CommentThreaded Is Nothing Then

Cdlt.

Bonjour xorsankukai

Ta macro marche à merveille! aucuns bugs merci beaucoup.

Par contre vu que sous excel 2019 les commentaires sont devenu des notes je pense qu'il faut l'adapter pour qu'elles puisse être utilisé sous toutes les versions.

Est il possible de rajouter une condition?

du style: If c.Value = "test" And Not c.Comment or c.CommentsThreaded Is Nothing Then

Sheets("Feuil2").Cells(i + 1, 1) = c.Comment.Text or c.CommentsThreaded

J'ai essayé rien ne se passe....

Merci!

Re,

Un essai ....

https://www.excel-pratique.com/fr/astuces_vba/action_differente_selon_version_excel

Sub test2()
 Dim ws As Worksheet
 Dim c As Range, i As Integer

 Application.ScreenUpdating = False

      Sheets("Feuil2").Range("A:A").ClearContents

  For Each ws In ThisWorkbook.Worksheets
   If ws.Name <> "Feuil2" Then
    For Each c In ws.Range("A7:U200")
     If Val(Application.Version) < 16 Then
      If c.Value = "test" And Not c.Comment Is Nothing Then
       Sheets("Feuil2").Cells(i + 1, 1) = c.Comment.Text
       i = i + 1
      End If
     Else
      If c.Value = "test" And Not c.CommentThreaded Is Nothing Then
       Sheets("Feuil2").Cells(i + 1, 1) = c.CommentThreaded.Text
       i = i + 1
      End If
     End If
    Next c
   End If
  Next ws

     Sheets("Feuil2").Activate
     Sheets("Feuil2").Cells.WrapText = False
End Sub

Cordialement,

Bonjour, la macro marche mais n'extrait que les commentaires à thread...je suis pénible....

Bonjour pic84, le forum,

Nouvel essai....pas testé.....

Sub test2()
 Dim ws As Worksheet
 Dim c As Range, i As Integer
 Dim x As String

 Application.ScreenUpdating = False

      Sheets("Feuil2").Range("A:A").ClearContents

  For Each ws In ThisWorkbook.Worksheets
   If ws.Name <> "Feuil2" Then
    For Each c In ws.Range("A7:U200")
     If Val(Application.Version) < 16 Then
      If c.Value = "test" And Not c.Comment Is Nothing Then
       Sheets("Feuil2").Cells(i + 1, 1) = c.Comment.Text
       i = i + 1
      End If
     Else
      If c.Value = "test" Then
       Select Case x
        Case Is = Not c.Comment Is Nothing And Not c.CommentThreaded Is Nothing
         x = c.Comment & " | " & c.CommentThreaded
        Case Is = c.Comment Is Nothing And Not c.CommentThreaded Is Nothing
         x = c.CommentThreaded
        Case Is = Not c.Comment Is Nothing And c.CommentThreaded Is Nothing
         x = c.Comment
       End Select
        Sheets("Feuil2").Cells(i + 1, 1) = x
       i = i + 1
      End If
     End If
    Next c
   End If
  Next ws

     Sheets("Feuil2").Activate
     Sheets("Feuil2").Cells.WrapText = False

End Sub

Sur 2 colonnes distinctes:

Sub test2()
 Dim ws As Worksheet
 Dim c As Range, i As Integer
 Dim x As String

 Application.ScreenUpdating = False

      Sheets("Feuil2").Range("A:B").ClearContents

  For Each ws In ThisWorkbook.Worksheets
   If ws.Name <> "Feuil2" Then
    For Each c In ws.Range("A7:U200")
     If Val(Application.Version) < 16 Then
      If c.Value = "test" And Not c.Comment Is Nothing Then
       Sheets("Feuil2").Cells(i + 1, 1) = c.Comment.Text
       i = i + 1
      End If
     Else
      If c.Value = "test" And Not c.Comment Is Nothing Then Sheets("Feuil2").Cells(i + 1, 1) = c.Comment.Text
      If c.Value = "test" And Not c.CommentThreaded Is Nothing Then Sheets("Feuil2").Cells(i + 1, 2) = c.CommentThreaded.Text
       i = i + 1
      End If
    Next c
   End If
  Next ws

     Sheets("Feuil2").Activate
     Sheets("Feuil2").Cells.WrapText = False

End Sub

Cordialement,

Bonjour xorsankukai,

Je te remercie d'avoir pris du temps pour m'aider à résoudre mon problème, la macro ou il est possible d'avoir les note et les commentaires dans 2 colonnes différente marche mais les infos sont toutes espacés de plusieurs lignes dans chaque colonne.

Ne t'embête pas à essayé de la corriger pour moi car j'ai pris une décision, le code ci dessous marche parfaitement dans mon fichier, je l'adapterais donc à mes besoins.

De plus, à l'utilisation je pourrais voir rapidement si il y a des commentaires thread, je passerais l'info et le premier qui utilisera ce type de commentaire écopera d'un forfait croissant/pains au chocolat .

Je ne sais pas si dois clôturer le sujet ou si tu veux tenter d'apporter des modification à ta macro pour la diffuser.

Merci!

Sub test2()

Dim ws As Worksheet

Dim c As Range, i As Integer

Application.ScreenUpdating = False

Sheets("Feuil2").Range("A:A").ClearContents

For Each ws In ThisWorkbook.Worksheets

If ws.Name <> "Feuil2" Then

For Each c In ws.Range("A7:U200")

On Error Resume Next

If c.Value = "test" And Not c.Comment Is Nothing Then

Sheets("Feuil2").Cells(i + 1, 1) = c.Comment.Text

i = i + 1

End If

Next c

End If

Next ws

Sheets("Feuil2").Activate

Sheets("Feuil2").Cells.WrapText = False

End Sub

Bonsoir pic84,

Merci pour le retour,

la macro ou il est possible d'avoir les note et les commentaires dans 2 colonnes différente marche mais les infos sont toutes espacés de plusieurs lignes dans chaque colonne.

Ma version d'excel ne gérant pas les "CommentThreaded", je ne peux donc pas tester....

Peut-etre ainsi:

Sub test2()
 Dim ws As Worksheet
 Dim c As Range, i As Integer, j As Integer
 Dim x As String

 Application.ScreenUpdating = False

      Sheets("Commentaires").Range("A:B").ClearContents

  For Each ws In ThisWorkbook.Worksheets
   If ws.Name <> "Commentaires" Then
    For Each c In ws.Range("A7:U200")
     If Val(Application.Version) < 16 Then
      If c.Value = "test" And Not c.Comment Is Nothing Then
       Sheets("Commentaires").Cells(i + 1, 1) = c.Comment.Text
       i = i + 1
      End If
     Else
      If c.Value = "test" And Not c.Comment Is Nothing Then
       Sheets("Commentaires").Cells(i + 1, 1) = c.Comment.Text
       i = i + 1
      End If
      If c.Value = "test" And Not c.CommentThreaded Is Nothing Then
       Sheets("Commentaires").Cells(j + 1, 2) = c.CommentThreaded.Text
       j = j + 1
     End If
    End If
    Next c
   End If
  Next ws
     Sheets("Commentaires").Activate
     Sheets("Commentaires").Cells.WrapText = False
End Sub

Cordialement,

Je vois que n'abandonne pas!

Je l'ai testé et j'ai ce message d'erreur: erreur 1004 "le modèle d'objet VBA pour les commentaires thématiques n'est pas pris en charge dans votre version Excel"

cdt

Bonjour,

Peux-tu joindre un fichier comportant des anciens et nouveaux commentaires ?

Cdlt.

Bonjour jean Eric,

Je voulais te renvoyer le fichier avec les différents commentaires que tu souhaites mais je me suis rendu compte que les commentaires thread était spécifique à Office 365, j'ai la version office 365 pro sur mon PC pro et je viens de d'installer office 2019 pro sur mon PC perso (pas de commentaires thread avec cette version), je ne peux donc rien faire avant la semaine prochaine.

Je trouve que Microsoft a un peu bâcler la fonction car selon la version un commentaire non thread est une note (office 365) et sur une autre un commentaire reste un commentaire (office 2019 dans mon cas) .

Cordialement