Set rngSource = YourRichTextField
YourTable(Cell x, y).Range.FormattedText = rSource

        Set oRng = DescriptionBox.TextRTF
        oRow.Cells(1).Range.FormattedText = oRng

 
oRow.Cells(1).Range.FormattedText  = DescriptionBox.TextRTF

oRow.Cells(1).Range.FormattedText.Text = Descriptionbox.TextRTF

Dim oRng as Range
Set oRng = DescriptionBox.TextRTF
oRow.Cells(1).Range.FormattedText = oRng

oRow.Cells(1).Range.FormattedText = DescriptionBox.TextRTF

Private Function testSaveRTF()
    Dim filePath As String
    Dim s As String
    s = "{\rtf1\ansi\ansicpg1252\deff0\deflang1033{\fonttbl {\f0\fnil\fcharset0 Tahoma;}{\f1\fnil\fcharset2 Symbol;}}{\*\generator Riched20 12.0.6606.1000;}\viewkind4\uc1\pard{\pntext\f1\'B7\tab}{\*\pn\pnlvlblt\pnf1\pnin dent0{\pntxtb\'B7}}\fi-360\li360\f0\fs17 This is an example\fs17\par }"
    filePath = ActiveDocument.Path + "\TempFile.rtf"
    Call SaveTextToFile(s, filePath)
End Function
 
Public Function SaveTextToFile(sText As String, _
                                Optional FileFullPath As String, _
                                Optional Overwrite As Boolean = False) As Boolean
    SaveTextToFile = True
On Error GoTo ErrorHandler
    Dim iFileNumber As Integer
    iFileNumber = FreeFile
    
    If Overwrite Then
       Open FileFullPath For Output As #iFileNumber
    Else
       Open FileFullPath For Append As #iFileNumber
    End If
    
    Print #iFileNumber, sText
    SaveTextToFile = True
    Close #iFileNumber
    
    Exit Function
ErrorHandler:
    SaveTextToFile = False
    Close #iFileNumber
End Function

'///////////////////////////////////////////////////////////////////////////////////
'////////////This function inserts the form data into the table/////////////////////
'///////////////////////////////////////////////////////////////////////////////////
Private Sub OKButton_Click()
 
Dim oTbl As Word.Table
Dim oRow As Row
Dim oRng As Word.Range
Dim oCtr As InlineShape
Dim dRTF As Word.Documents
'Declare variables
Select Case True
    Case DescriptionBox = vbNullString
        'Check for empty description box
      MsgBox "You must enter a description"
    Case PriorityCombo = vbNullString
        'Check for empty priority box
        MsgBox "You must select the priority."
    Case Else
        'Input is good, add to table
        Set oTbl = ActiveDocument.Tables(1)
        Set oRow = oTbl.Rows.Add
        'Add new row for data
        DescriptionBox.SaveFile ("Temp.rtf")
        Documents.Open FileName:="\\Server\EMPNum$\G\Temp.rtf", _
        ConfirmConversions:=False, ReadOnly:=False, AddToRecentFiles:=False, _
        PasswordDocument:="", PasswordTemplate:="", Revert:=False, _
        WritePasswordDocument:="", WritePasswordTemplate:="", Format:= _
        wdOpenFormatAuto, XMLTransform:=""
        Selection.WholeStory
        Selection.Copy
        oRow.Cells(1).Range.PasteAndFormat (wdPasteDefault)
        oRow.Cells(2).Range.Text = PriorityCombo.Text
        Set oCtr = oRow.Range.Cells(3).Range.InlineShapes.AddOLEControl(ClassType:="Forms.CheckBox.1")
        oCtr.OLEFormat.Object.Caption = ""
        oCtr.OLEFormat.Object.Width = 14
        'Populate columns
        Unload Me
        'Unload form
        Windows("Temp.rtf [Compatibility Mode]").Close
        DeleteFile ("Temp.rtf")
End Select
End Sub
'//////////////////END//////////////////////////////////////////////////////////////
 
'///////////////////////////////////////////////////////////////////////////////////
'////////////////////Programmed by: John P. Brunetta////////////////////////////////
'///////////////////////Position: Summer Student////////////////////////////////////
'/////////////This function unloads the user form, frmNewItem///////////////////////
'///////////////////////////////////////////////////////////////////////////////////
Private Sub CancelButton_Click()
 
Unload Me
'Unload form
End Sub
'//////////////////END//////////////////////////////////////////////////////////////
 
'///////////////////////////////////////////////////////////////////////////////////
'//////////This function initializes the contents of the Priority combobox//////////
'///////////////////////////////////////////////////////////////////////////////////
Private Sub UserForm_Initialize()
 
PriorityCombo.Clear
PriorityCombo.AddItem "SMT"
PriorityCombo.AddItem "Monthly"
PriorityCombo.AddItem "Newsletter"
DescriptionBox.SelBullet = True
End Sub
'//////////////////END//////////////////////////////////////////////////////////////
 
'///////////////////////////////////////////////////////////////////////////////////
'/////////This function checks if a file with the name passed exists////////////////
'///////////////////////////////////////////////////////////////////////////////////
Function FileExists(ByVal FileToTest As String) As Boolean
   FileExists = (Dir(FileToTest) <> "")
End Function
'//////////////////END//////////////////////////////////////////////////////////////
 
'///////////////////////////////////////////////////////////////////////////////////
'///////////////This function deletes a file if it exists///////////////////////////
'///////////////////////////////////////////////////////////////////////////////////
Sub DeleteFile(ByVal FileToDelete As String)
   If FileExists(FileToDelete) Then 'See above
      SetAttr FileToDelete, vbNormal
      Kill FileToDelete
   End If
End Sub
'//////////////////END//////////////////////////////////////////////////////////////