Redimensionner automatiquement une shape par rapport à son contenu

Bonjour,

Avec votre aide j'ai pu réaliser ce code suivant pour insérer une shape (ici un cercle) dans laquelle se copie le contenu d'une cellule qui est incrémentée à chaque nouvelle shape.

Or le contenu étant différent à chaque fois (A,B,C...X,Y,Z,A1,B1,...Z1,A2,B2...), la taille prédéfinie de la bulle ne convient plus. Soit la bulle est trop grande, soit la bulle est trop petite et le chiffre n’apparaît pas à coté de la lettre quand il y en a un...

En partant de mon code ci dessous, y a t-il un moyen pour rendre automatique la taille de la bulle par rapport à son contenu (tout comme on peut le faire avec une cellule)?

Merci d'avance !

Sub BULLE()

    PP = Sheets("Plan-1").Range("BH4").Value
    ActiveSheet.Shapes.AddShape(msoShapeOval, 875, 275, 45, 30).Select
    Selection.ShapeRange.TextFrame2.VerticalAnchor = msoAnchorMiddle
    Selection.ShapeRange.Name = PP
    Selection.ShapeRange(1).TextFrame2.TextRange.Characters.Text = PP
    With Selection.ShapeRange(1).TextFrame2.TextRange.Characters(1, 1). _
        ParagraphFormat
        .FirstLineIndent = 0
        .Alignment = msoAlignCenter
    End With
    With Selection.ShapeRange(1).TextFrame2.TextRange.Characters(1, 1).Font
        .NameComplexScript = "+mn-cs"
        .NameFarEast = "+mn-ea"
        .Fill.Visible = msoTrue
        .Fill.ForeColor.ObjectThemeColor = msoThemeColorLight1
        .Fill.ForeColor.TintAndShade = 0
        .Fill.ForeColor.Brightness = 0
        .Fill.Transparency = 0
        .Fill.Solid
        .Size = 15
        .Name = "+mn-lt"
    End With
    With Selection.ShapeRange.TextFrame2.TextRange.Font.Fill
        .Visible = msoTrue
        .ForeColor.RGB = RGB(0, 0, 0)
        .Transparency = 0
        .Solid
    End With
    With Selection.ShapeRange.Line
        .Visible = msoTrue
        .ForeColor.RGB = RGB(0, 0, 0)
        .Transparency = 0
        .Weight = 2.25
    End With
    Selection.ShapeRange.Fill.Visible = msoFalse
    FindShape
    IncBH4

End Sub

Bonjour,

à tester,

Selection.ShapeRange(1).TextFrame2.AutoSize = msoAutoSizeShapeToFitText

Bonjour sabV,

Merci pour cette réponse.

Alors effectivement ce code influe sur la dimension de la shape mais en hauteur et non en largeur...

Par exemple pour le "A", la shape ne bouge pas, mais pour le "W3", la shape s’agrandit en hauteur. Du coupon ne voit que "W3".

Peut être n'ai je pas inséré la ligne au bon endroit ? (je l'ai placée juste avant le end sub)

Bonjour,

y a t-il un moyen pour rendre automatique la taille de la bulle par rapport à son contenu

je ne comprend pas de quel façon vous voulez redimantionner le shape,

vous pouvez essayer les autres constantes MsoAutoSize:

msoAutoSizeMixed

msoAutoSizeNone

msoAutoSizeShapeToFitText

msoAutoSizeTextToFitShape

Ne maîtrisant que très peu excel je me suis aidé de l'enregistreur de macros pour créer une bulle.

J'ai donc obtenu une localisation de bulle et une taille que j'ai arrondie :

ActiveSheet.Shapes.AddShape(msoShapeOval, 875, 275, 45, 30).Select

dans cette bulle j'insère ensuite le contenu d'une cellule qui varie de A à Z4 (en suivant la logique que j'ai expliqué dans mon premier message). Pour les 26 premières lettres, le contenu s'affiche bien dans la bulle, mais passé la première incrémentation (A1) les difficultés apparaissent. Pour les caractères assez larges (W4 par exemple), le "4" n’apparaît pas dans la bulle, je suis obligé d’agrandir manuellement la bulle après l'action de la macro.

D'où ma question, est il possible d'ajouter dans ma macro un ligne qui dimensionne automatiquement ma bulle après avoir inséré le contenu de la cellule

PS : j'ai essayé les 4 différents code mais sans succès...

pouvez-vous joindre votre fichier ?

Petite explication du fonctionnement :

• A l'ouverture taper "1" dans les deux inputbox et fermer le userform "norme".
• Aller sur la feuille "Plan-1" et cliquer sur le bouton "bulle" pour faire apparaitre une bulle avec le contenu de rangeBH4 et appuyer au choix sur "haut", "bas", "gauche" ou "droite" pour faire apparaitre une flèche et incrémenter rangeBH4.
• RangeBH4 peut être modifiée manuellement pour faire le test du dimensionnement automatique

Les macros se trouvent sur la feuille "Plan-1", module 3 & 4.

Bonjour,

une autre possibilité serait d'enlever le retour à la ligne,

Selection.ShapeRange(1).TextFrame2.WordWrap = msoFalse

Génial ça fonctionne !

Merci beaucoup pour l'aide !