En s'occupant un peu de l'apparence du résultat :
'----------------------------------
Sub GetComments()
Dim C As Comment, Rg As Range, T As Variant
Dim Sh As Worksheet, Sh1 As Worksheet, A As Integer
Application.ScreenUpdating = False
Set Sh1 = Worksheets.Add
With Sh1
.Range("A1") = "Provient de: "
.Range("A1").ColumnWidth = 30
.Range("B1") = "Auteur: "
.Range("B1").ColumnWidth = 45
.Range("C1") = "Commentaire: "
.Range("C1").ColumnWidth = 60
With .Range("A1:C1")
.Font.Size = 16
.Font.Bold = True
End With
End With
A = 1
For Each Sh In Worksheets
If Sh.Name <> Worksheets(Sh1.Name).Name Then
For Each C In Sh.Comments
A = A + 1
Range("A" & A) = _
C.Parent.Parent.Name & "!" _
& C.Parent.Address
T = Split(Replace(C.Text, Chr(10), ""), ":")
If UBound(T) = 1 Then
Range("B" & A) = Trim(T(0))
Range("C" & A) = Trim(T(1))
Else
Range("B" & A) = "Non disponible"
Range("C" & A) = T(0)
End If
Next
End If
Next
Set C = Nothing: Set Sh = Nothing: Set Sh1 = Nothing
End Sub
'----------------------------------
Salutations!
"Denis Michon" a écrit dans le message de
news:n4_ib.160338$
Bonjour Bourby,
Voici une procédure qui recupère toutes les commentaires de toutes les
feuilles et en fait un résumé dans une autre
feuille sous 3 colonnes
A ) Colonne A : le nom de la feuille et de la cellule
B ) Colonne B : L'auteur du commentaire
C ) le commentaire
Cette procédure ne s'exécute correctement que sur une version Excel 2000
ou plus récent, à cause de la fontion Split()
utilisée.
'-----------------------------------
Sub GetComments()
Dim C As Comment, Rg As Range, T As Variant
Dim Sh As Worksheet, Sh1 As Worksheet, A As Integer
Set Sh1 = Worksheets.Add
With Sh1
.Range("A1") = "Provient de: "
.Range("B1") = "Auteur: "
.Range("C1") = "Commentaire: "
End With
A = 1
For Each Sh In Worksheets
If Sh.Name <> Worksheets(Sh1.Name).Name Then
For Each C In Sh.Comments
A = A + 1
Range("A" & A) = _
C.Parent.Parent.Name & "!" _
& C.Parent.Address
T = Split(C.Text, ":")
If UBound(T) = 1 Then
Range("B" & A) = T(0)
Range("C" & A) = T(1)
Else
Range("C" & A) = T(0)
End If
Next
End If
Next
Set C = Nothing: Set Sh = Nothing: Set Sh1 = Nothing
End Sub
'-----------------------------------
Salutations!
"Bourby" a écrit dans le message de
news:
bonjour,
j'ai reçu un fichier Excel où les infos intéressantes étaient en fait
dans les commentaires , fort nombreux: des centaines. La plupart
comportaient des
retour chariot ("Enter").....
Je veux récupérer les commentaires dans des cellules
(afin de les avoir sous les yeux), en respectant les
retours chariot (donc un commentaire avec 2 retours chariot
doit occuper 3 cellules). Et créer des groupes pour pouvoir
revenir à l'aspect initial du fichier.
-Question 1:
Dans Excel, si on fait:
modifier le commentaire
(sélection du texte tout entier)
Escape
coller dans une cellule,
alors on récupère bien du texte dans 3 cellules.
Ensuite, j'ai écrit un code VBA (ci-dessous),
qui marche à peu près, mais je n'ai pas réussi à
me dépatouiller de la mise en forme de mes cellules
lorsque je traitais tout le texte du commentaire globalement.
Il a fallu que je traite chaque caractère séparément.
Y aurai-t il une méthode qui ressemble à la manip Excel. En VBA,
je ne suis pas arrivé à lui faire "copier" le commentaire....
-Question 2:
dans le commentire, il y a un "titre" (mon nom), qui
apparaît par défaut lorsque j'encode un nouveau commentaire;
plus le "texte" du commentaire.
Ma macro ne récupère pas le titre.
Comment faire? (le fichier reçu a été rempli
successivement par plein de collègues différents).
D'avance merci pour vos lumières.
Bourby
Sub InsérerCommentairesDansCellulesEtGrouper()
' les commentaires à récupérer sont dans une plage rectangulaire
' de quelques colonnes x un grand nombre de lignes
' on sélectionne cette plage avant d'exécuter la macro
Dim maPlage As Range, Ligne As Integer, Colonne As Integer
Dim nbLignesInsérées As Integer, nbSauts As Integer
Dim monTexte As String
Set maPlage = Selection
For Ligne = maPlage.Row + maPlage.Rows.Count - 1 To maPlage.Row
Step -1
nbLignesInsérées = 0
For Colonne = maPlage.Column + maPlage.Columns.Count - 1 To
maPlage.Column Step -1
With Cells(Ligne, Colonne)
nbSauts = 0
If Not .Comment Is Nothing Then
monTexte = ""
For i = Len(.Comment.Text) To 1 Step -1
If Mid(.Comment.Text, i, 1) = Chr(10) Then
nbSauts = nbSauts + 1
nbLignesInsérées = nbLignesInsérées + 1
.Offset(1, 0).EntireRow.Insert
With Range(Cells(Ligne + 1, maPlage.Column), _
Cells(Ligne + 1, maPlage.Column +
maPlage.Columns.Count - 1))
.Interior.ColorIndex = -4142 'les cellules d'origine
sont colorées
End With
.Offset(1, 0).Formula = monTexte
monTexte = ""
Else
monTexte = Mid(.Comment.Text, i, 1) & monTexte
End If
Next i
End If
End With
Next Colonne
With Cells(Ligne, Colonne)
Range(.Offset(1, 0), .Offset(nbLignesInsérées, 0)).Rows.Group
End With
Next Ligne
End Sub
En s'occupant un peu de l'apparence du résultat :
'----------------------------------
Sub GetComments()
Dim C As Comment, Rg As Range, T As Variant
Dim Sh As Worksheet, Sh1 As Worksheet, A As Integer
Application.ScreenUpdating = False
Set Sh1 = Worksheets.Add
With Sh1
.Range("A1") = "Provient de: "
.Range("A1").ColumnWidth = 30
.Range("B1") = "Auteur: "
.Range("B1").ColumnWidth = 45
.Range("C1") = "Commentaire: "
.Range("C1").ColumnWidth = 60
With .Range("A1:C1")
.Font.Size = 16
.Font.Bold = True
End With
End With
A = 1
For Each Sh In Worksheets
If Sh.Name <> Worksheets(Sh1.Name).Name Then
For Each C In Sh.Comments
A = A + 1
Range("A" & A) = _
C.Parent.Parent.Name & "!" _
& C.Parent.Address
T = Split(Replace(C.Text, Chr(10), ""), ":")
If UBound(T) = 1 Then
Range("B" & A) = Trim(T(0))
Range("C" & A) = Trim(T(1))
Else
Range("B" & A) = "Non disponible"
Range("C" & A) = T(0)
End If
Next
End If
Next
Set C = Nothing: Set Sh = Nothing: Set Sh1 = Nothing
End Sub
'----------------------------------
Salutations!
"Denis Michon" <denis.michon@cgocable.ca> a écrit dans le message de
news:n4_ib.160338$C92.44469@charlie.risq.qc.ca...
Bonjour Bourby,
Voici une procédure qui recupère toutes les commentaires de toutes les
feuilles et en fait un résumé dans une autre
feuille sous 3 colonnes
A ) Colonne A : le nom de la feuille et de la cellule
B ) Colonne B : L'auteur du commentaire
C ) le commentaire
Cette procédure ne s'exécute correctement que sur une version Excel 2000
ou plus récent, à cause de la fontion Split()
utilisée.
'-----------------------------------
Sub GetComments()
Dim C As Comment, Rg As Range, T As Variant
Dim Sh As Worksheet, Sh1 As Worksheet, A As Integer
Set Sh1 = Worksheets.Add
With Sh1
.Range("A1") = "Provient de: "
.Range("B1") = "Auteur: "
.Range("C1") = "Commentaire: "
End With
A = 1
For Each Sh In Worksheets
If Sh.Name <> Worksheets(Sh1.Name).Name Then
For Each C In Sh.Comments
A = A + 1
Range("A" & A) = _
C.Parent.Parent.Name & "!" _
& C.Parent.Address
T = Split(C.Text, ":")
If UBound(T) = 1 Then
Range("B" & A) = T(0)
Range("C" & A) = T(1)
Else
Range("C" & A) = T(0)
End If
Next
End If
Next
Set C = Nothing: Set Sh = Nothing: Set Sh1 = Nothing
End Sub
'-----------------------------------
Salutations!
"Bourby" <nospam-jchfer@wanadoo.fr> a écrit dans le message de
news:e9AUH0okDHA.2200@TK2MSFTNGP12.phx.gbl...
bonjour,
j'ai reçu un fichier Excel où les infos intéressantes étaient en fait
dans les commentaires , fort nombreux: des centaines. La plupart
comportaient des
retour chariot ("Enter").....
Je veux récupérer les commentaires dans des cellules
(afin de les avoir sous les yeux), en respectant les
retours chariot (donc un commentaire avec 2 retours chariot
doit occuper 3 cellules). Et créer des groupes pour pouvoir
revenir à l'aspect initial du fichier.
-Question 1:
Dans Excel, si on fait:
modifier le commentaire
(sélection du texte tout entier)
Escape
coller dans une cellule,
alors on récupère bien du texte dans 3 cellules.
Ensuite, j'ai écrit un code VBA (ci-dessous),
qui marche à peu près, mais je n'ai pas réussi à
me dépatouiller de la mise en forme de mes cellules
lorsque je traitais tout le texte du commentaire globalement.
Il a fallu que je traite chaque caractère séparément.
Y aurai-t il une méthode qui ressemble à la manip Excel. En VBA,
je ne suis pas arrivé à lui faire "copier" le commentaire....
-Question 2:
dans le commentire, il y a un "titre" (mon nom), qui
apparaît par défaut lorsque j'encode un nouveau commentaire;
plus le "texte" du commentaire.
Ma macro ne récupère pas le titre.
Comment faire? (le fichier reçu a été rempli
successivement par plein de collègues différents).
D'avance merci pour vos lumières.
Bourby
Sub InsérerCommentairesDansCellulesEtGrouper()
' les commentaires à récupérer sont dans une plage rectangulaire
' de quelques colonnes x un grand nombre de lignes
' on sélectionne cette plage avant d'exécuter la macro
Dim maPlage As Range, Ligne As Integer, Colonne As Integer
Dim nbLignesInsérées As Integer, nbSauts As Integer
Dim monTexte As String
Set maPlage = Selection
For Ligne = maPlage.Row + maPlage.Rows.Count - 1 To maPlage.Row
Step -1
nbLignesInsérées = 0
For Colonne = maPlage.Column + maPlage.Columns.Count - 1 To
maPlage.Column Step -1
With Cells(Ligne, Colonne)
nbSauts = 0
If Not .Comment Is Nothing Then
monTexte = ""
For i = Len(.Comment.Text) To 1 Step -1
If Mid(.Comment.Text, i, 1) = Chr(10) Then
nbSauts = nbSauts + 1
nbLignesInsérées = nbLignesInsérées + 1
.Offset(1, 0).EntireRow.Insert
With Range(Cells(Ligne + 1, maPlage.Column), _
Cells(Ligne + 1, maPlage.Column +
maPlage.Columns.Count - 1))
.Interior.ColorIndex = -4142 'les cellules d'origine
sont colorées
End With
.Offset(1, 0).Formula = monTexte
monTexte = ""
Else
monTexte = Mid(.Comment.Text, i, 1) & monTexte
End If
Next i
End If
End With
Next Colonne
With Cells(Ligne, Colonne)
Range(.Offset(1, 0), .Offset(nbLignesInsérées, 0)).Rows.Group
End With
Next Ligne
End Sub
En s'occupant un peu de l'apparence du résultat :
'----------------------------------
Sub GetComments()
Dim C As Comment, Rg As Range, T As Variant
Dim Sh As Worksheet, Sh1 As Worksheet, A As Integer
Application.ScreenUpdating = False
Set Sh1 = Worksheets.Add
With Sh1
.Range("A1") = "Provient de: "
.Range("A1").ColumnWidth = 30
.Range("B1") = "Auteur: "
.Range("B1").ColumnWidth = 45
.Range("C1") = "Commentaire: "
.Range("C1").ColumnWidth = 60
With .Range("A1:C1")
.Font.Size = 16
.Font.Bold = True
End With
End With
A = 1
For Each Sh In Worksheets
If Sh.Name <> Worksheets(Sh1.Name).Name Then
For Each C In Sh.Comments
A = A + 1
Range("A" & A) = _
C.Parent.Parent.Name & "!" _
& C.Parent.Address
T = Split(Replace(C.Text, Chr(10), ""), ":")
If UBound(T) = 1 Then
Range("B" & A) = Trim(T(0))
Range("C" & A) = Trim(T(1))
Else
Range("B" & A) = "Non disponible"
Range("C" & A) = T(0)
End If
Next
End If
Next
Set C = Nothing: Set Sh = Nothing: Set Sh1 = Nothing
End Sub
'----------------------------------
Salutations!
"Denis Michon" a écrit dans le message de
news:n4_ib.160338$
Bonjour Bourby,
Voici une procédure qui recupère toutes les commentaires de toutes les
feuilles et en fait un résumé dans une autre
feuille sous 3 colonnes
A ) Colonne A : le nom de la feuille et de la cellule
B ) Colonne B : L'auteur du commentaire
C ) le commentaire
Cette procédure ne s'exécute correctement que sur une version Excel 2000
ou plus récent, à cause de la fontion Split()
utilisée.
'-----------------------------------
Sub GetComments()
Dim C As Comment, Rg As Range, T As Variant
Dim Sh As Worksheet, Sh1 As Worksheet, A As Integer
Set Sh1 = Worksheets.Add
With Sh1
.Range("A1") = "Provient de: "
.Range("B1") = "Auteur: "
.Range("C1") = "Commentaire: "
End With
A = 1
For Each Sh In Worksheets
If Sh.Name <> Worksheets(Sh1.Name).Name Then
For Each C In Sh.Comments
A = A + 1
Range("A" & A) = _
C.Parent.Parent.Name & "!" _
& C.Parent.Address
T = Split(C.Text, ":")
If UBound(T) = 1 Then
Range("B" & A) = T(0)
Range("C" & A) = T(1)
Else
Range("C" & A) = T(0)
End If
Next
End If
Next
Set C = Nothing: Set Sh = Nothing: Set Sh1 = Nothing
End Sub
'-----------------------------------
Salutations!
"Bourby" a écrit dans le message de
news:
bonjour,
j'ai reçu un fichier Excel où les infos intéressantes étaient en fait
dans les commentaires , fort nombreux: des centaines. La plupart
comportaient des
retour chariot ("Enter").....
Je veux récupérer les commentaires dans des cellules
(afin de les avoir sous les yeux), en respectant les
retours chariot (donc un commentaire avec 2 retours chariot
doit occuper 3 cellules). Et créer des groupes pour pouvoir
revenir à l'aspect initial du fichier.
-Question 1:
Dans Excel, si on fait:
modifier le commentaire
(sélection du texte tout entier)
Escape
coller dans une cellule,
alors on récupère bien du texte dans 3 cellules.
Ensuite, j'ai écrit un code VBA (ci-dessous),
qui marche à peu près, mais je n'ai pas réussi à
me dépatouiller de la mise en forme de mes cellules
lorsque je traitais tout le texte du commentaire globalement.
Il a fallu que je traite chaque caractère séparément.
Y aurai-t il une méthode qui ressemble à la manip Excel. En VBA,
je ne suis pas arrivé à lui faire "copier" le commentaire....
-Question 2:
dans le commentire, il y a un "titre" (mon nom), qui
apparaît par défaut lorsque j'encode un nouveau commentaire;
plus le "texte" du commentaire.
Ma macro ne récupère pas le titre.
Comment faire? (le fichier reçu a été rempli
successivement par plein de collègues différents).
D'avance merci pour vos lumières.
Bourby
Sub InsérerCommentairesDansCellulesEtGrouper()
' les commentaires à récupérer sont dans une plage rectangulaire
' de quelques colonnes x un grand nombre de lignes
' on sélectionne cette plage avant d'exécuter la macro
Dim maPlage As Range, Ligne As Integer, Colonne As Integer
Dim nbLignesInsérées As Integer, nbSauts As Integer
Dim monTexte As String
Set maPlage = Selection
For Ligne = maPlage.Row + maPlage.Rows.Count - 1 To maPlage.Row
Step -1
nbLignesInsérées = 0
For Colonne = maPlage.Column + maPlage.Columns.Count - 1 To
maPlage.Column Step -1
With Cells(Ligne, Colonne)
nbSauts = 0
If Not .Comment Is Nothing Then
monTexte = ""
For i = Len(.Comment.Text) To 1 Step -1
If Mid(.Comment.Text, i, 1) = Chr(10) Then
nbSauts = nbSauts + 1
nbLignesInsérées = nbLignesInsérées + 1
.Offset(1, 0).EntireRow.Insert
With Range(Cells(Ligne + 1, maPlage.Column), _
Cells(Ligne + 1, maPlage.Column +
maPlage.Columns.Count - 1))
.Interior.ColorIndex = -4142 'les cellules d'origine
sont colorées
End With
.Offset(1, 0).Formula = monTexte
monTexte = ""
Else
monTexte = Mid(.Comment.Text, i, 1) & monTexte
End If
Next i
End If
End With
Next Colonne
With Cells(Ligne, Colonne)
Range(.Offset(1, 0), .Offset(nbLignesInsérées, 0)).Rows.Group
End With
Next Ligne
End Sub