CODEWITHSUNDEEP
vbaexcel
David G
David G

Reputation: 2347

Paste cell content to a textbox including text formats

What I want to do

I have some formatted text in a cell. For example, in cell A1 I could have : aaa bbb ccc

I would like to send this text, with its format, to a textbox (NOT in a userform).

The macro recorder simply copies the text and then adjusts the format as such:

Range("A3").Select
    Selection.Copy
    ActiveSheet.Shapes.Range(Array("txt_1")).Select
    Selection.ShapeRange(1).TextFrame2.TextRange.Characters.Text = "aaa bbb ccc "
    Selection.ShapeRange(1).TextFrame2.TextRange.Characters(1, 8).ParagraphFormat. _
        FirstLineIndent = 0
    With Selection.ShapeRange(1).TextFrame2.TextRange.Characters(1, 4).Font
        .Bold = msoFalse
        .NameComplexScript = "+mn-cs"
        .NameFarEast = "+mn-ea"
        .Fill.Visible = msoTrue
        .Fill.ForeColor.ObjectThemeColor = msoThemeColorDark1
        .Fill.ForeColor.TintAndShade = 0
        .Fill.ForeColor.Brightness = 0
        .Fill.Transparency = 0

          etc etc

I read about copying the cell and pasting in a textbox but nothing seems to conserve text format. Something like 

ActiveSheet.Paste Destination:=Feuil1.Shapes.Range(Array("txt_1"))

Would be great but that's apparently not how to paste into a textbox using VBA.

Upvotes: 1

Views: 3907

Answers (3)

David
David

Reputation: 1232

Here's a solution... I used the ActiveCell value in the example, but you could use the value of A3. This sets the ActiveCell value to Textbox 1, then loops through the ActiveCell characters looking to see if they are bold or italic, then sets formatting of individual characters in Textbox 1 accordingly:

Sub passCharToTextbox()

    'select Textbox 1:
    ActiveSheet.Shapes.Range(Array("Textbox 1")).Select

    'set text:
    Selection.ShapeRange(1).TextFrame2.TextRange.Characters.Text = ActiveCell.Value

    'loop through characters in original cell:
    For i = 1 To Len(ActiveCell.Value)

        'add bold/italic to the new character if necessary:
        If ActiveCell.Characters(i, 1).Font.Bold = True Then
            Selection.ShapeRange(1).TextFrame2.TextRange.Characters(i, 1).Font.Bold = True
        Else
            Selection.ShapeRange(1).TextFrame2.TextRange.Characters(i, 1).Font.Bold = False
        End If
        If ActiveCell.Characters(i, 1).Font.Italic = True Then
            Selection.ShapeRange(1).TextFrame2.TextRange.Characters(i, 1).Font.Italic = True
        Else
            Selection.ShapeRange(1).TextFrame2.TextRange.Characters(i, 1).Font.Italic = False
        End If

    Next i

End Sub

Upvotes: 1

Dirk Reichel
Dirk Reichel

Reputation: 7979

As far as I know, you need to do the special formatting for each character by yourself. This way you could iterate through them to set the .Bolt / .Italic.... values. Or cheat like this:

Sub Macro()
  Range("A3").Copy
  ActiveSheet.Shapes.Range(Array("txt_1")).ShapeRange(1).Select
  Application.SendKeys ("^v")
End Sub

While that is a dirty way to do it... it should work... at least :/

Upvotes: 1

Weasemunk
Weasemunk

Reputation: 455

You will need the Microsoft Forms 2.0 Object library.

Dim x As New MSForms.DataObject
Set x = New MSForms.DataObject
Selection.Copy
x.GetFromClipboard
ActiveSheet.Shapes.Range(Array("txt_1")).Select
Selection.ShapeRange(1).TextFrame2.TextRange.Characters.Text = x.getText(1)

That should maintain formatting while allowing you to paste to a user control. Please let me know if this solves your problem.

Sources: Paste to TextBox, Paste from clipboard VBA

Upvotes: 0

Related Questions