Autres Mise en forme automatique des Commentaires sous Excel 2007

Sub ajustComm()
    Dim pl As Range, c As Range, ch As String
    Set pl = Selection.Cells.SpecialCells(xlCellTypeComments)
    Application.ScreenUpdating = False
    If Not pl Is Nothing Then
        For Each c In pl
            c.Comment.Text decoupCh(c.Comment.Text, 80)
            c.Comment.Shape.TextFrame.AutoSize = True
        Next c
    End If
End Sub

Function decoupCh(ch As String, lMax As Long, Optional suppVbLF = False) As String
    Dim pos As Long, tmp, i As Long
    'insère chr(10) tous les x caractères, sans couper les mots
    If ch <> "" And InStr(ch, " ") > 0 Then
        If suppVbLF Then ch = Replace(ch, vbLf, " ")
        tmp = Split(ch, vbLf)
        For i = 0 To UBound(tmp)
            If tmp(i) <> "" Then
                pos = lMax + 1
                Do
                    pos = InStrRev(tmp(i), " ", pos)
                    If pos = 0 Then Exit Do
                    Mid(tmp(i), pos, 1) = vbLf
                    pos = pos + lMax + 1
                Loop Until pos >= Len(tmp(i))
            End If
        Next i
    End If
    decoupCh = Join(tmp, vbLf)
End Function

Sub FormaterCommentairesTest()
Dim c As Excel.Comment
For Each ws In Worksheets
For Each c In ws.Comments
c.Shape.Fill.ForeColor.RGB = RGB(170, 255, 155)
c.Shape.TextFrame.AutoSize = -1 '0 '1 '-1 ' 0
NBCarCom = Len(c.Text)
If NBCarCom < 30 Then Fact = 1 Else Fact = 0.4
c.Shape.ScaleWidth Fact, msoFalse, msoScaleFromTopLeft
c.Shape.ScaleHeight 2, msoFalse, msoScaleFromTopLeft
Next c
Next ws
End Sub
Sub Commentaire_Position()
    Dim co As Comment
    For Each co In ActiveSheet.Comments
        co.Shape.Left = Range(co.Parent.Address).Offset(0, 1).Left + 170
        co.Shape.Top = Range(co.Parent.Address).Offset(0, 1).Top + 1
    Next co
End Sub

Sub TailleFixeCommentaire()
For Each c In ActiveSheet.Comments
'c.Visible = True
NbCarCo = Len(c.Text)
'NewLargeur 200 minimum
NewLArgeur = 200
c.Shape.Fill.ForeColor.RGB = RGB(170, 255, 155)
c.Shape.TextFrame.Characters.Font.Name = "Arial"
c.Shape.Width = NewLArgeur 'largeur
Rapport = Int(((0.35 * NbCarCo) + 30))
If NbCarCo > 30 Then c.Shape.Height = Rapport + 20 Else c.Shape.Height = 30       ' Hauteur
'c.Shape.Height = 80  ' Hauteur
c.Shape.Line.Transparency = 0# 'degré d'opacité de la bordure
c.Shape.Line.ForeColor.SchemeColor = 8 'bordure en noir
c.Shape.Line.Weight = 0.25 'épaisseur de la bordure
Next c
End Sub