Microsoft Office Forums - View Single Post - How to extract text from a cell and preserve special formatting?

Larry Sulky · 04-04-2014, 01:43 PM

The most effective way I've found to do this is to mark the special formatting first with codes (might as well use XML syntax), grab your text, then remove the codes:

Code:

Sub test()
    
    With Selection.Find
        .ClearFormatting
        .Replacement.ClearFormatting
        .Text = ""
        .Forward = True
        .Wrap = wdFindContinue
        .Format = True
        .MatchCase = False
        .MatchWholeWord = False
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
    End With
    
    Selection.HomeKey Unit:=wdStory
    With Selection.Find
        .Font.Superscript = True
        .Replacement.Text = "<sup>^&</sup>"
    End With
    Selection.Find.Execute Replace:=wdReplaceAll
    
    Selection.HomeKey Unit:=wdStory
    With Selection.Find
        .Font.Bold = True
        .Replacement.Text = "<b>^&</b>"
    End With
    Selection.Find.Execute Replace:=wdReplaceAll

    Dim varTextString As Variant
    varTextString = ActiveDocument.Tables(1).Cell(Row:=1, Column:=1)
    varTextString = Left(varTextString, Len(varTextString) - 2)
    MsgBox varTextString

    Selection.HomeKey Unit:=wdStory
    With Selection.Find
        .Text = "<sup>"
        .Replacement.Text = ""
    End With
    Selection.Find.Execute Replace:=wdReplaceAll
    
    Selection.HomeKey Unit:=wdStory
    With Selection.Find
        .Text = "</sup>"
        .Replacement.Text = ""
    End With
    Selection.Find.Execute Replace:=wdReplaceAll
   
    Selection.HomeKey Unit:=wdStory
    With Selection.Find
        .Text = "<b>"
        .Replacement.Text = ""
    End With
    Selection.Find.Execute Replace:=wdReplaceAll
    
    Selection.HomeKey Unit:=wdStory
    With Selection.Find
        .Text = "</b>"
        .Replacement.Text = ""
    End With
    Selection.Find.Execute Replace:=wdReplaceAll

End Sub