Ajouter une zone de commentaire à dimension variable ?

[lebarbo]

Bonjour à tous,

Je cherche à ajouter automatiquement une zone de commentaire sur une cellule.
Jusque là tout va bien, j'utilise le code ci-dessous :

Sheets(NomFeuil).Range("B" & i).AddComment
Sheets(NomFeuil).Range("B" & i).Comment.Text Text:=Moncommentaire

Mais je souhaiterais que le commentaire s'ajuste automatiquement en hauteur (car tous les commentaires ne font pas le même nombre de caractère) et c'est là que je bloque car j'utilise le code ci-dessous mais qui le dimensionne à une taille fixe :
Sheets(NomFeuil).Range("B" & i).Comment.Shape.ScaleWidth 2.58, msoFalse, msoScaleFromTopLeft
Sheets(NomFeuil).Range("B" & i).Comment.Shape.ScaleHeight 2.15, msoFalse, msoScaleFromTopLeft

Merci pour votre aide,

 

[Dranreb]

Re : Ajouter une zone de commentaire à dimension variable ?

Bonjour.

Pourquoi ne ne le mettriez vous pas .AutoSize = True avant de rectifier seulement la largeur, éventuellement ?

Exemple de code :

Sub Test()
MsgBox "Ancien commentaire :" & vbLf & Comt(ActiveCell)
Comt(ActiveCell) = InputBox("Nouveau commentaire.")
End Sub

Property Get Comt(ByVal Cel As Range) As String
Dim Cmt As Comment
Set Cmt = Cel.Comment
If Cmt Is Nothing Then Comt = "(sans)" Else Comt = Cmt.Text
End Property
Property Let Comt(ByVal Cel As Range, ByVal Texte As String)
Dim Cmt As Comment
Set Cmt = Cel.Comment
If Cmt Is Nothing Then Set Cmt = Cel.AddComment
Cmt.Text Texte
With Cmt.Shape.TextFrame
   .HorizontalAlignment = xlCenter
   .VerticalAlignment = xlCenter
   .AutoMargins = False
   .MarginLeft = 7.5: .MarginRight = 7.5
   .MarginTop = 2.5: .MarginBottom = 2.5
   .AutoSize = True: End With
Cmt.Shape.Line.Visible = msoFalse
Cmt.Shape.Shadow.Type = msoShadow14
End Property

 

[PMO2]

Re : Ajouter une zone de commentaire à dimension variable ?

Bonjour,

Une piste en VBA avec la démarche suivante.
1) Créez un nouveau classeur avec une feuille nommée "test"
2) Copiez le code suivant dans un module Standard

Sub aa()
Dim MonCommentaire As String
'--- Un premier commentaire ---
MonCommentaire = "Ajouter une zone de commentaire à dimension variable ?" & _
"Bonjour à tous, Je cherche à ajouter automatiquement une zone de commentaire sur une cellule.*" & _
"Jusque là tout va bien, j'utilise le code ci-dessous :" & _
"Mais je souhaiterais que le commentaire s'ajuste automatiquement en hauteur (car tous les " & _
"commentaires ne font pas le même nombre de caractère) et c'est là que je bloque car j'utilise le code  " & _
"ci-dessous mais qui le dimensionne à une taille fixe : Merci pour votre aide."

'### Les arguments de MakeComment ###
'Feuille_Cible As String
'Cellule_Cible As String
'Mon_Texte As String
'Taille_Police As Long
Call MakeComment(Feuille_Cible:="test", _
                 Cellule_Cible:="B16", _
                 Mon_Texte:=MonCommentaire, _
                 Taille_Police:=11)
                 
'--- Un autre commentaire ---
MonCommentaire = "Simone Zaza (né le 25 juin 1991 à Policoro en Basilicate) est un joueur de football italien, qui évolue au poste d'attaquant." & _
"Il joue actuellement avec le club de Sassuolo en Serie A. Le 31 août 2014, il est convoqué pour faire partie de l'équipe nationale italienne par Antonio Conte."
Call MakeComment(Feuille_Cible:="test", _
                 Cellule_Cible:="j20", _
                 Mon_Texte:=MonCommentaire, _
                 Taille_Police:=18)
'--- Encore un autre commentaire ---
MonCommentaire = "Création de Commentaire s'ajustant à la taille du texte et à celle de la police"
Call MakeComment(Feuille_Cible:="test", _
                 Cellule_Cible:="e3", _
                 Mon_Texte:=MonCommentaire, _
                 Taille_Police:=36)
End Sub


Sub MakeComment(Feuille_Cible As String, Cellule_Cible As String, Mon_Texte As String, Optional Taille_Police As Long = 8)
Dim COM As Comment
Dim TB As TextBox
Dim CoeffFontSize!
'--- On détruit le commentaire s'il est déjà existant ---
Set COM = Sheets(Feuille_Cible).Range(Cellule_Cible).Comment
If Not COM Is Nothing Then COM.Delete
'--- On crée le commentaire ---
Set COM = Sheets(Feuille_Cible).Range(Cellule_Cible).AddComment
COM.Text Text:=Mon_Texte
COM.Visible = True
'--- On récupère la TextBox du commentaire ---
Set TB = COM.Shape.DrawingObject
TB.Font.Size = 8  'on force avecla taille mini
TB.AutoSize = True
TB.Font.Size = Taille_Police
'--- On met le commentaire à une taille correcte ---
'##########################################################
'### Ce qui suit est un algorithme arbitraire (au pifomètre)
'### On pourrait déterminer de manière plus exacte avec les
'### APIs mais c'est très compliqué
'##########################################################
CoeffFontSize! = TB.Font.Size / 8
TB.Width = 165 * CoeffFontSize
TB.Height = ((Len(Mon_Texte) \ 40) * 11.5) * CoeffFontSize!
End Sub

3) Lancez la Sub aa