Autres Mise en forme automatique des Commentaires sous Excel 2007

[Jybe]

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 😱)
Merci d'avance pour vos réponses

JB

 

[patricktoulon]

re
c'est quoi la taille max souhaité?
en visuel SVP

POUR INFO
voila comment est vraiment ton texte dans ton commentaire
j'ai espacer d'une ligne en plus pour bien voir les lignes réelles

c'est plus des commentaire qu'il faut mais des panneau d'affichage 😛 😛 😛

 

[Jybe]

le commentaire Dragon Warrior doit être un des plus longs

 

[Jybe]

j'ai lu qlq part qu'il fallait des chr(13) pour remplacer les chr(10) ...

 

[Jybe]

une largeur de 500 me paraît adaptée pour mon fichier

 

[Jybe]

Je suis entièrement d'accord avec toi PatrickToulon, c'est pour ça que j'ai besoin de largeur fixe et hauteur auto (c'est le meilleur moyen que j'ai trouvé pour gérer cette "base de données")

 

[Staple1600]

Re,

Pas probant, à tester avec une cellule active contenant le commentaire.

Sub TestSurUnCommentaire()
Dim t, i&, Z$
With ActiveCell
t = Split(.Comment.Text, Chr(10))
'MsgBox UBound(t) 'pour test
Z = Join(t, vbNewLine)
.Comment.Delete: .AddComment: .Comment.Text Text:=Z
.Comment.Shape.TextFrame.AutoSize = True
End With
End Sub

 

[patricktoulon]

non Staple
les chr(10/13) subissent le wraptext
donc si on part sur une largeur de 500 en gardant les vrai vbcrlf on peut tenter l'astuce du textbox avec vbcurline dans une boucle

vous connaissez ?

 

[Staple1600]

Re

patricktoulon
Je te laisse prendre le relais
(Je viens de me souvenir qu'Excel à la base est un tableur)
😉

 

[patricktoulon]

😉 je viens de faire des tests et même la le wraptext prend le dessus
donc

ta dernière semble faire quelque chose de propre un peu large les com mais bon c'est le texte qui veut ça
a la place du autosize mettre une limite de largeur et il se débrouillera avec ça
terminé 😉

 

[Jybe]

Merci pour votre aide à tous les 2, je vais me contenter de mettre une largeur à 500 via macro puis je réglerai à la main le reste ...
Encore merci,
@+

 

[VIARD]

Bonjour Jybe, Patrick, Staple

Je viens juste de tombé sur le sujet.
Et comme de mon côté j'ai traité le sujet.
On peut ainsi placer une formule en commentaire ou du texte.
ou plusieurs cellules contigus en commentaire, etc.

A+ Jean-Paul

 

[Staple1600]

Re, Bonsoir Viard

Très bel ouvrage (que je me souviens avoir vu passé dans une de tes réponses dans un fil)
C'est OK pour créér des commentaires

Mais est-ce que tu vois comment faire pour traiter des commentaires déjà créés?
Voir l'exemple du fichier de Jybe (qui pour moi reste une colle à l'heure actuelle)

 

[patricktoulon]

re
pas mal l'interface commentaire +++

@Staple1600 je pensait adapter l'astuce du textbox pour cells au commentaire
en dimensionnant le textbox a une limite max
voila l'astuce

Sub testligne()
    Set cel = [A1]    '
    MsgBox Join(lignes(cel), vbCrLf)
End Sub
Sub testligne3()
     MsgBox lignes([A1])(3) 'devrait donner la même ligne que la ligne 4 dans la cellule
End Sub
Function lignes(cel)
   Dim T, i#
 
   Set T = ActiveSheet.OLEObjects.Add(ClassType:="Forms.TextBox.1", Link:=False, DisplayAsIcon:=False, Left:=1, Top:=1, Width:=cel.Width, Height:=cel.Height)
     With T
        .Name = "wrapp"
        .Activate
        .Object.Value = cel.Value
        .Object.AutoSize = False
        .Object.MultiLine = True
        .Object.WordWrap = True
        .Object.SelectionMargin = False
        .Object.Font.Size = cel.Font.Size
        .Object.Font.Name = cel.Font.Name
        .Object.Font.Bold = cel.Font.Bold
        .Object.Font.Italic = cel.Font.Italic
       
        For i = .Object.LineCount - 1 To 1 Step -1
            .Object.CurLine = .Object.LineCount - i
            .Object.SelText = vbCrLf
        Next
        lignes = Split(Replace(.Object.Value, vbCrLf & vbCrLf, vbCrLf), vbCrLf)
       End With

  ActiveSheet.OLEObjects("wrapp").Delete
  End Function

les lignes sont restituées comme on les vois a l'ecran mais avec des vrais sauts de ligne

 

[Staple1600]

Re,

J'ai qlq chose comme 900 commentaires à mettre en forme, c'est pour ça q j'insiste sur la hauteur automatique (quitte à être un peu relou)

J'en suis resté là
Le problème n'est pas de créer des commentaires mais de titiller les 900 existants! 😉
(Bonjour les yeux)

 

[Staple1600]

Re

En creusant, et en traversant l'Atlantique, avec deux trois modifs

Spoiler: On se rapproche, non?

Sub test()
Dim Rng As Range
For Each Rng In ActiveSheet.UsedRange
If HasComment(Rng) Then
AutoSize_Comment Rng
End If
Next
End Sub

Private Function AutoSize_Comment(ByRef r As Range)
    Dim cellComment As Comment  ' selected cell
    Dim area As Double          ' comment rectangle area
    Dim n As Integer, vS As Variant
    Dim myMax As Integer, base As Single, rowLen As Integer
    Dim Wf As WorksheetFunction
    Dim vR(), rowCnt As Integer, myHeight As Single
    Set Wf = WorksheetFunction
    Const MAX_COMMENT_WIDTH = 300
    ' Make sure we have a seected cell.
    If r Is Nothing Then
        Exit Function
    End If
    ' Make sure we have a comment in the selected cell.
    Set cellComment = r.Comment
    If cellComment Is Nothing Then
        Exit Function
    End If
    With cellComment
        'myLen = Len(.Text)
        vS = Split(.Text, Chr(10))
        ReDim vR(UBound(vS))
        For i = 0 To UBound(vS)
            vR(i) = Len(vS(i))
        Next i
        myMax = Wf.Max(vR)
        n = UBound(vS)
        ' AutoSize will covert comment to a single line.
        .Shape.TextFrame.AutoSize = True

        ' If comment's width is shorter than max, we're done.
        With .Shape
            base = .Height / (n + 1)
            rowLen = Wf.RoundDown(myMax * (300 / .Width), 0) 'row character's length when width 300
            rowLen = rowLen - rowLen * 0.1 '<~~line character's number  is more small.
            For i = 0 To n
                If Len(vS(i)) = 0 Then
                    rowCnt = rowCnt + 1
                Else
                    rowCnt = rowCnt + Wf.RoundUp(Len(vS(i)) / rowLen, 0)
                End If
            Next i
            myHeight = rowCnt * base

            If .Width < MAX_COMMENT_WIDTH Then
                Exit Function
            End If
            .Width = 300
            .Height = myHeight
        End With
    End With
End Function
Private Function HasComment(Cell As Range) As Boolean
Dim oComment As Comment
On Error Resume Next
Set oComment = Cell.Comment
If Not (oComment Is Nothing) Then HasComment = True
End Function

NB: Si le coeur vous en dit, peaufinez le truc

PS: Merci à Dy.Lee (c'est le gars qui cause anglais dans le VBA ici soumis😉)