Copy active cell text to textboox with all formatting

[stewart1]

Hi to all.

I hope you and yours are all keeping well and safe in such challenging times. I am now working from home and looking after my family now schools have closed here.

I am hoping someone can help.

I am looking to run a macro that will copy all formatting contents of an active cell into my textbox. This includes font style, itallics, font colour. Basically what ever was used in terms of composing that test, it will ttransfer exactly to the textbox.

The textbox will allow the user to type freely with their text. It is then I hope to run a second macro that will take from the textbox and put back into the active cell once the user has finished. This again would include all types of text formatting.

Despite my best efforts I have found little code or it has been conflicting.

The following code has allowed for italic and font. I need it to account for further text variable styles.

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

Many thanks in advance for taking the time to look.

Stu

 

[CountTepes]

Instead of using If - Then - Else statements. e.g.

       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

Try using

Selection.ShapeRange(1).TextFrame2.TextRange.Characters(i, 1).Font.Bold = ActiveCell.Characters(i, 1).Font.Bold

You can shorten the code even more by using With

    For i = 1 To Len(ActiveCell.Value)
         With  Selection.ShapeRange(1).TextFrame2.TextRange.Characters(i, 1).Font
               .Bold = ActiveCell.Characters(i, 1).Font.Bold
              .Italic = ActiveCell.Characters(i, 1).Font.Italic
        End With
    Next i

 

[stewart1]

Instead of using If - Then - Else statements. e.g.

       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

Try using

Selection.ShapeRange(1).TextFrame2.TextRange.Characters(i, 1).Font.Bold = ActiveCell.Characters(i, 1).Font.Bold

You can shorten the code even more by using With

    For i = 1 To Len(ActiveCell.Value)
         With  Selection.ShapeRange(1).TextFrame2.TextRange.Characters(i, 1).Font
               .Bold = ActiveCell.Characters(i, 1).Font.Bold
              .Italic = ActiveCell.Characters(i, 1).Font.Italic
        End With
    Next i

Lovely thank you, that is helpful! Do you know the right vba for font colour. This is the real clincher as there could be a mixture of different font colours in the cell text that I would need to import to the textbox, write in, and export back again.

Big thanks so far!

 

[stewart1]

So I am trying with the new code from CounTepes which is fine, but when I add colour, underline and fontstyle the line breaks on colour :

Sub passCharToTextbox2()

    '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)
         With Selection.ShapeRange(1).TextFrame2.TextRange.Characters(i, 1).Font
               .Bold = ActiveCell.Characters(i, 1).Font.Bold
              .Italic = ActiveCell.Characters(i, 1).Font.Italic
              .Color = ActiveCell.Characters(i, 1).Font.Color
             .Underline = ActiveCell.Characters(i, 1).Font.Underline
             .FontStyle = ActiveCell.Characters(i, 1).Font.FontStyle
             
             
        End With
    Next i

Any advice here will be greatly appreciated.

Stu