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 lin de la demande initiale et du fichier déposé en #3.