Autres Mise en forme automatique des Commentaires sous Excel 2007

Jybe

XLDnaute Nouveau
Bonjour,

J'ai pas mal fouillé dans ce site (sans avoir trouvé Graal) avant de me décider à poster ma question :
Existe-t-il sous Excel 2007 un moyen de mettre en forme - sur plusieurs feuilles - tous les commentaires : largeur fixe, hauteur automatique ?
Je vous précise que je suis une bille en VBA :eek:)
Merci d'avance pour vos réponses

JB
 

eriiic

XLDnaute Barbatruc
Bonjour,

ayant eu ce type de besoin, je ne m'étais pas trop embêté.
Un retour chariot tous les x caractères max à la place d'une espace et ça le fait :
VB:
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
Enfin moi ça me suffisait ;-)
Par contre je n'ai lu les 3 pages qu'en diagonale, désolé si ça a été déjà refusé
eric
 

MJ13

XLDnaute Barbatruc
Bonjour à tous

Le sujet m'intéressant, j'ai fait ce petit code en modifiant un code de Jybe. A voir si on se rapproche du résultat attendu, mais ne m'en demander pas plus. :)

Et Commentaire_Position, c'est un routine issue de mon Pense bête.

VB:
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
 

patricktoulon

XLDnaute Barbatruc
re
bonjour a tous
pour info
j'ai trouvé dans les astuces ce lien
 

MJ13

XLDnaute Barbatruc
Bonjour à tous

Désolé JM, je ne savais même pas que c'était de toi, faut dire que c'était pas marqué dans la procédure. :cool:

Bon, sinon, j'ai trouvé une routine sur le net que j'ai modifié avec une petite droite de régression. :)

Par contre, le code d'Eriiic, whaou, ça, c'est du code, je comprend pourquoi, il cite les Shadoks. :oops:


VB:
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
 
Dernière édition:

Discussions similaires

Membres actuellement en ligne

Aucun membre en ligne actuellement.

Statistiques des forums

Discussions
311 725
Messages
2 081 941
Membres
101 848
dernier inscrit
Djigbenou