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
 

patricktoulon

XLDnaute Barbatruc
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

demo3.gif


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

Staple1600

XLDnaute Barbatruc
Re,

Pas probant, à tester avec une cellule active contenant le commentaire.
VB:
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

XLDnaute Barbatruc
;) 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é ;)
 

VIARD

XLDnaute Impliqué
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
 

Pièces jointes

  • Commentaire_3.xlsm
    48.4 KB · Affichages: 8

Staple1600

XLDnaute Barbatruc
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

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

XLDnaute Barbatruc
Re

En creusant, et en traversant l'Atlantique, avec deux trois modifs
VB:
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;))
 

Discussions similaires

Statistiques des forums

Discussions
311 711
Messages
2 081 799
Membres
101 818
dernier inscrit
tiftouf5757