Sub ContenuSelonLargeur()
Dim ws As Worksheet, largeur As Single, c As Range, i As Integer
Application.ScreenUpdating = False
On Error Resume Next
Set ws = ActiveSheet
largeur = [A1].ColumnWidth
Workbooks.Add 'nouveau document
For Each c In ws.[A1:A10]
[A1] = ""
[COLOR="Red"] If c = Left(c.Comment.Text, Len(c) - 3) & "..." _
Or c = Left(c.Comment.Text, Len(c) - 1) & Chr(133) Then c = c.Comment.Text
c.Comment.Delete[/COLOR]
For i = Len(c) To 1 Step -1
[A1].ColumnWidth = largeur
[A1] = Left(c.Text, i) & IIf(i = Len(c.Text), "", Chr(133)) 'Chr(133): 3 points liés
[A1].Columns.AutoFit 'ajustement automatique
If [A1].ColumnWidth <= largeur Then Exit For
Next
If i < Len(c.Text) Then
c.AddComment
c.Comment.Text c.Text
End If
c = [A1]
Next
ActiveWorkbook.Close False
End Sub