Taille Shape Commentaire

Le 25/04/2021 à 14:03

Bonjour,

J'ai une macro qui génère des commentaires. J'ai fait en sorte que la taille des commentaires soit en autosize, ce qui marche bien. En revanche, si le commentire est trop grand, ça part en longueur :

image

J'ai essayé avec une condition avec le code ci-dessous mais ça ne marche pas. Des idées pour que la taille soit en autosize mais qui fait des retours en ligne à partir d'une certaine longueur ?

Sub Test_Taille_Com

Cells(2, 2).AddComment
Com = "AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA"
    Cells(2, 2).Comment.Text Text:=Com
    Cells(2, 2).Comment.Shape.TextFrame.AutoSize = True
        W = Cells(2, 2).Comment.Shape.Width
        H = Cells(2, 2).Comment.Shape.Height
            If W > 200 Then
                With Cells(2, 2).Comment.Shape
                    .Width = 200
                End With
            End If
End Sub

Merci

Le 25/04/2021 à 17:32

Bonjour;

Ceci:

Sub Test_Taille_Com()
    Cells(2, 2).AddComment
    Com = "AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA"
    Cells(2, 2).Comment.Text Text:=Com
        W = Cells(2, 2).Comment.Shape.Width
        H = Cells(2, 2).Comment.Shape.Height
        If Len(Com) > 100 Then
            With Cells(2, 2).Comment.Shape
                .Width = 200
            End With
        Else
            Cells(2, 2).Comment.Shape.TextFrame.AutoSize = True
        End If
End Sub

Cdlt

Le 25/04/2021 à 19:21

Bonsoir…

et ainsi ?

Sub Test_Taille_Com()
Dim Tx As String
    [B2].ClearComments: [B2].AddComment
    Tx = "AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA"
    MsgBox Len(Tx) 'pour avoir une idée de longueur valable
    Tx = Left(Tx, 70) & vbLf & Right(Tx, Len(Tx) - 70) 'ici moitié de la longueur
    [B2].Comment.Text Tx
    [B2].Comment.Shape.TextFrame.AutoSize = 9 'ou autre que False qui est égal à 0
End Sub

Nota : Eviter des noms de variables comme Com.

L’insertion de plus d’un « vbLf » permet d’avoir plus de 2 lignes

Le 25/04/2021 à 20:12

Merci.

Mais ce que je veux (ne sachant pas si c'est faisable) c'est de faire en sorte que ça s'ajuste automatiquement comme suit :

Shape en autosize

Si Largeur > 200 alors Largeur = 200 et hauteur en autosize

Le 25/04/2021 à 23:39

Bonjour,

ce que j'utilise.
Pas tout à fait ta demande mais ça peut t'intéresser si ton commentaire est fait de mots et non d'une chaine ininterrompue.
Je raisonne en nombre maxi de caractères autorisés par ligne, ici 80, sans couper les mots.
Si tu passe une plage à pl, toutes les cellules avec commentaire seront traitées individuellement.
Sinon met-lui seulement ta cellule.

' sur la plage sélectionnée
' insère chr(10) tous les x caractères des commentaires, sans couper les mots
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

eric

Le 26/04/2021 à 08:21

Bonjour Eric,

Merci. C'est très ingénieux et ça marche bien. Cependant, un hic important : Une fois le texte découpé, il ne se recompose plus.

Je m'explique : J'ai testé avec une limite de 80, puis avec 60 puis avec 20 ... Dans cette ordre, ça marche, mais si on fait d'abord 20, on ne peut plus revenir à un découpage plus important. Et pire encore, même si on réajuste la case manuellement, le texte ne suit pas :

image image
Le 26/04/2021 à 08:28

Ah c'est bon, j'ai réglé le souci avec un add et clear comment :

' sur la plage sélectionnée
' insère chr(10) tous les x caractères des commentaires, sans couper les mots
Sub ajustComm()
    Dim pl As Range, c As Range, ch As String
    [B2].ClearComments
    [B2].AddComment
    [B2].Comment.Text Text:="Je veux tester l'ajustement de la case des commentaires en essayant la méthode de découpage de texte avec limite de caractès"
    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, 60)
            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
Le 26/04/2021 à 08:38

Bonjour,

Et pire encore, même si on réajuste la case manuellement, le texte ne suit pas

tu as un paramètre optionnel Optional suppVbLF = False pour supprimer les retours à la ligne.
Il faut appeler la fonction avec : c.Comment.Text decoupCh(c.Comment.Text, 80, True)

Seulement on ne peut distinguer ceux qui y étaient à l'origine, tous sont remplacés par une espace.
Une fois trouvée ta bonne largeur sur un texte de test il faut le remettre à False (ou l'enlever) et traiter ta plage si tu as des retours à conserver absolument.
eric

Rechercher des sujets similaires à "taille shape commentaire"