convertir le contenu de cellule a zone de texte

[lyahyaii]

bonjour mes amis
et ce que vous m'aider pour convertir le contenu de cellule a zone de texte
en vba

 

[DoubleZero]

Re-bonjour,

Regarde la pièce jointe 1004710

lyahyaii, vos réponses sont "brèves"...

🙄😵

 

[Staple1600]

Re

@lyahyaii
Si j'ai "dimé" sh As Shape
C'est pour l'utiliser
PS: Tu as vu que nous deux sur le fil à te répondre
Il serait peut-être temps que tu salues DoubleZero 😉 , non ?

Sub Cellule2Shape()
Dim sh As Shape
With ActiveCell
    Set sh = ActiveSheet.Shapes.AddTextbox(msoTextOrientationHorizontal, .Left, .Top, .Width, .Height)
    sh.TextFrame2.TextRange = .Value
    sh.TextFrame2.VerticalAnchor = msoAnchorMiddle
    sh.TextFrame2.HorizontalAnchor = msoAnchorCenter
    sh.TextFrame2.WordArtformat = msoTextEffect31
    sh.ShapeStyle = msoLineStylePreset13
    .Clear
End With
End Sub

NB: 00, l'écart s'agrandit, tu as posté deux minutes avant moi 😉
Ou alors tu as le neurone dominical plus guilleret et alerte que le mien
(c'est normal, le mien est amoindri par une céphalée de derrière les fagots)

 

[lyahyaii]

salut
Ce lien n'existe plus

 

[lyahyaii]

pour agrandir le texte

 

[lyahyaii]

Sub Cellule1Shape()
Dim sh As Shape
With ActiveCell
Set sh = ActiveSheet.Shapes.AddTextbox(msoTextOrientationHorizontal, .Left, .Top, .Width, .Height)
sh.TextFrame2.TextRange = .Value
sh.TextFrame2.VerticalAnchor = msoAnchorMiddle
sh.TextFrame2.HorizontalAnchor = msoAnchorCenter
sh.TextFrame2.WordArtformat = msoTextEffect31
sh.ShapeStyle = msoLineStylePreset13
sh.TextFrame2.TextRange.Font.Size = 20
.Clear
End With
End Sub

 

[lyahyaii]

merci
Ce lien n'existe plus

Ce lien n'existe plus

 

[Staple1600]

Re,

@lyahyaii
Etre laconique ou peu disert, c'est pas forcément folichon sur un forum...
Tu es timide?
Une version avec un surplus d'endive 😉

Sub Cell_To_Shape() 'D'où le Cell2Shape initial
Dim sh As Shape
With ActiveCell
    Set sh = ActiveSheet.Shapes.AddTextbox(1, .Left, .Top, .Width, .Height)
        With sh.TextFrame2
            .TextRange = ActiveCell.Value: .VerticalAnchor = 3: .HorizontalAnchor = 2
            .WordArtformat = 30: .TextRange.Font.Size = 20
        End With
    sh.ShapeStyle = 10013
    .Clear
End With
End Sub

 

[Staple1600]

Re

Une variante paramétrée (on peut choisir la forme et ce facilement grâce à Intellisense)
Pour tester, lance la macro testDessin
Et pour changer de forme, voir la copie d'écran plus bas

Sub testDessin()
ActiveSheet.DrawingObjects.Delete
Cells.Clear
[A1] = Date: [A1].Select
Formez_Les_Rangs msoShape32pointStar
[E1] = Time * Application.Pi(): [E1].Select
Formez_Les_Rangs msoShapeFlowchartMagneticDisk
End Sub
Private Sub Formez_Les_Rangs(TypeF As MsoAutoShapeType)
Dim sh As Shape
With ActiveCell
    Set sh = ActiveSheet.Shapes.AddShape(TypeF, .Left, .Top, .Width, .Height)
        With sh.TextFrame2
            .TextRange = ActiveCell.Value: .VerticalAnchor = 3: .HorizontalAnchor = 2
            .WordArtformat = 30: .TextRange.Font.Size = 20
        End With
    sh.ShapeStyle = 10013
    .Clear
End With
End Sub

 

[lyahyaii]

🙂merci

 

[Staple1600]

Re,

@lyahyaii
Ah oui, tu as définitivement perdu ta langue ?
Pas d'autres commentaires à ajouter sur mon dernier code?
Tu as testé avec différentes formes?
Si oui, tu aurais du constaté un léger problème, non ?

 

[lyahyaii]

n'affiche pas exactement la continu de cellule

 

[Staple1600]

Re

Tel qu'écrit
Set sh = ActiveSheet.Shapes.AddShape(TypeF, .Left, .Top, .Width, .Height)
La forme prend la taille de la cellule active.
Donc si tu l'agrandis manuellement, la solution sans macro
(détaillée dans les messages#2 et#4) est plus rapide 😉

 

[Staple1600]

Re

Histoire de varier la variante 😉
NB: A tester sur une feuille vide, d'un classeur vierge.
(C'est plus prudent 😉 )

Sub testDessin_II()
ActiveSheet.DrawingObjects.Delete
Cells.Clear
[C3] = Date
Formez_Les_Rangs Range("C3"), msoShapeNonIsoscelesTrapezoid, 200, 200
[K8] = Application.UserName
Formez_Les_Rangs Range("K8"), msoShapeMoon, 400, 400
End Sub
Private Sub Formez_Les_Rangs(Cellule As Range, TypeF As MsoAutoShapeType, vW As Long, vH As Long)
Dim sh As Shape
With Cellule
    Set sh = ActiveSheet.Shapes.AddShape(TypeF, .Left, .Top, vW, vH)
        With sh.TextFrame2
            .TextRange = Cellule.Value: .VerticalAnchor = 3: .HorizontalAnchor = 2
            .WordArtformat = 30: .TextRange.Font.Size = 20
        End With
    sh.ShapeStyle = 10013
    sh.LockAspectRatio = msoTrue
    sh.ScaleHeight 0.95, msoFalse, msoScaleFromTopLeft
    sh.ScaleWidth 0.95, msoFalse, msoScaleFromTopLeft
    .Clear
End With
End Sub

 

[lyahyaii]

comment je peux faire pour plusieurs colonnes

 

[DoubleZero]

Re-bonjour,

Nous sommes l🙄in de la demande initiale et du fichier déposé en #3.

😵😵