CODEWITHSUNDEEP
excel
stu
stu

Reputation: 5

Copy from textbox to cell and maintain all formatting with vba

Good afternoon to all. I now need be able to send the formatted textbox back to the originating active cell.

This code was copy format from cell to textbox, I now need to reverse this process

Sub passCharToTextbox()
   CopycellFormat ActiveCell
End Sub

Private Sub CopycellFormat(cell As Range)
If Trim(cell(1, 1).Value) = vbNullString Then MsgBox ("select only cell / not emptycell"): Exit Sub
Dim textrange As TextRange2, tbox1 As Shape, fontType As Font2
    With ActiveSheet
    On Error Resume Next: Err.Clear 'check if Textbox 2 exist
    Set tbox1 = .Shapes("Textbox 2"): Set textrange = tbox1.TextFrame2.textrange
    textrange.Characters.Text = cell.Value
    If Err.Number > 0 Then MsgBox ("Not found Textbox 2")

    For i = 1 To Len(cell.Value)
        Set fontType = textrange.Characters(i, 1).Font
        With cell.Characters(i, 1)
            fontType.Bold = IIf(.Font.Bold, True, 0)                    'add bold/
            fontType.Italic = IIf(.Font.Italic, True, 0)                'add italic/
            fontType.UnderlineStyle = IIf(.Font.Underline > 0, msoUnderlineSingleLine, msoNoUnderline) 'add underline/
        textrange.Characters(i, 1).Font.Fill.ForeColor.RGB = .Font.Color 'add Font color
        End With
    Next i


    tbox1.Fill.ForeColor.RGB = cell.Interior.Color 'add background color
    End With
End Sub

Many thanks for taking the time to read, and please everyone, stay well.

Upvotes: 0

Views: 762

Answers (1)

Dang D. Khanh
Dang D. Khanh

Reputation: 1471

focus on your problem:

  • First, make sure "textbox 2" exists
  • Then, Select the cell need to copy format and run the code CopyFormat_fromTextbox_toCell

Here's following code:

    Sub CopyFormat_fromTextbox_toCell()
        CopycellFormat1 activecell
    End Sub 

    Private Sub CopycellFormat1(cell As Range) 
    Dim textrange As TextRange2, tbox1 As Shape, fontType As Font2, cellfont As Font 
     With ActiveSheet
        Set tbox1 = .Shapes("Textbox 2"): Set textrange = tbox1.TextFrame2.textrange
        cell.Value = textrange.Characters.Text
        For i = 1 To Len(cell.Value)
            Set fontType = textrange.Characters(i, 1).Font
            Set cellfont = cell.Characters(i, 1).Font
            With fontType
                cellfont.Bold = IIf(.Bold, True, 0)                     'add bold/
                cellfont.Italic = IIf(.Italic, True, 0)                 'add italic/
                cellfont.Underline = IIf(.UnderlineStyle > 0, 2, -4142) 'add underline/
                cellfont.Color = textrange.Characters(i, 1).Font.Fill.ForeColor.RGB 'add Font color
            End With
        Next i
        cell.Interior.Color = tbox1.Fill.ForeColor.RGB 'add background color
      End With 
   End Sub

Upvotes: 2

Related Questions