Cell values Text to be copied to Smart Shapes

[fareedexcel]

Dear Experts,

I have cell values in multiple rows where I need to copy those cell values to a defined shape.

The order of the cell values should not get changed.

By clicking a button, cell values needs to be copied to shapes

Note - Attached the output.

 

[chirayu]

try this in the file

Sub ShapeTxt()

'Define variables
Dim Rng As Range
Dim Subrng As Range
Dim Txt As String

'Set Variables
Txt = ActiveSheet.Range("D7")
Set Rng = ActiveSheet.Range("D8:D11")
For Each Subrng In Rng
    Txt = Txt & vbNewLine & Subrng
Next Subrng

'Select the shape
ActiveSheet.Shapes.Range(Array("Snip and Round Single Corner Rectangle 1")).Select

'Write the text from cell range to shape
Selection.ShapeRange(1).TextFrame2.TextRange.Characters.Text = Txt

'Bold & Underline Header
With Selection.ShapeRange(1).TextFrame2.TextRange.Characters(1, 10).Font
    .Bold = msoTrue
    .UnderlineStyle = msoUnderlineSingleLine
End With

End Sub

 

[fareedexcel]

Thanks for the code,

I'm getting error in the following line,

ActiveSheet.Shapes.Range(Array("Snip and Round Single Corner Rectangle 1")).Select

 

[Marc L]

Hi !

For any mod do not forget the Macro Recorder
but as a starter to copy cells text to a smart shape :​

Sub Demo1()
    ActiveSheet.Shapes("Snip and Round Single Corner Rectangle 1").TextFrame.Characters.Text = Join([TRANSPOSE(D7:D11)], vbLf)
End Sub

Do you like it ? So thanks to click on bottom right Like !
​

 

[chirayu]

Change this

ActiveSheet.Shapes.Range(Array("Snip and Round Single Corner Rectangle 1")).Select

To this

ActiveSheet.Shapes.Range("Snip and Round Single Corner Rectangle 1").Select

See if that works. Unsure why it errors on your file as the code works fine on my pc

 

[Marc L]

Same error on my side with your post #2 code, maybe it depends on
Excel version but, as often using Select is source of issues,
better is to not use it and directly work on object like my post #4 sample …
​

 

[fareedexcel]

Dear Chirayu,

Now the sheet is working fine. But the underline and bold is coming for all the 5 lines. It should come only for the header.

And also is there any option to clear the text in the shapes?

 

[Marc L]

No option, just logic like .Text = "" …

Manually remove any formatting in the text shape then delete text.
Run the next code, if you well operated manually, text is OK.
(If not, manually remove …)
Once result is OK, run the code a second time : what do you observe ?​

Sub DemoIfAnyTextShapeCouldBeSmart()
    With ActiveSheet.Shapes("Snip and Round Single Corner Rectangle 1").TextFrame
             .Characters.Text = Join([TRANSPOSE(D7:D11)], vbLf)
        With .Characters(1, Len([D7].Text)).Font
             .Bold = [D7].Font.Bold
             .Underline = [D7].Font.Underline
        End With
    End With
End Sub

Do you like it ? So thanks to click on bottom right Like !
​

 

[fareedexcel]

Hi Marc & Chirayu,

The below Code I have tried but not getting the desired result,

Sub ShapeTxt()

'Define variables
Dim Rng As Range
Dim Subrng As Range
Dim Txt As String

'Set Variables
Txt = ActiveSheet.Range("B31")
Set Rng = ActiveSheet.Range("B32:B35")
For Each Subrng In Rng
Txt = Txt & vbNewLine & Subrng
Next Subrng

'Select the shape
ActiveSheet.Shapes.Range(Array("Snip and Round Single Corner Rectangle 3")).Select

'Write the text from cell range to shape
Selection.ShapeRange(1).TextFrame2.TextRange.Characters.Text = Txt

'Bold & Underline Header
With ActiveSheet.Shapes("Snip and Round Single Corner Rectangle 3").TextFrame
.Characters.Text = Join([TRANSPOSE(B31:B35)], vbLf)
With .Characters(1, Len([B31].Text)).Font
.Bold = [B31].Font.Bold
.Underline = [B31].Font.Underline
End With
End With
End Sub

Here B31 is the Heading which needs to be underlined and bold
And B32:B35 should come below the heading without bold and underlined.

Please advise

 

[fareedexcel]

Also please advise how to delete the text inside the shapes? By assigning to a button?

 

[fareedexcel]

Also please advise how to delete the text inside the shapes? By assigning to a button?

This I have sorted out. Thanks