Paste from Excel to Word, font colour doesn't reflect

Currently, now when I copy and paste over from excel to word using vba, everything is perfect, including formatting. However, I have one problem which is that the title (which is in the first cell of the table) is black after it is pasted on word. The title consists of two letters (1st letter black and 2nd letter red) and I need the Red colour for the 2nd letter to reflect on the word. Please help and advise!

I've tried using pastespecial code and the colour does appear, however, the formatting goes haywire and I would ideally like to retain using the pasteexceltable code if possible. Thanks !

Sub contractDCN()


Sheets("Print").UsedRange.Clear
Sheets("DCN Inputs").Select

If Not IsEmpty(Sheets("DCN Inputs").Range("ProductToggle")) Then
Sheets("DCN Master").Rows("1:26").Copy Destination:=Sheets("Print").Range("A" & Cells(Rows.Count, 1).End(xlUp).Row)
End If

If Sheets("DCN Inputs").Range("CouponOption").Value = "Fixed" Then
Sheets("DCN Master").Rows("27:34").Copy Destination:=Sheets("Print").Cells(Rows.Count, 1).End(xlUp).Offset(1, 0)
ElseIf Sheets("DCN Inputs").Range("CouponOption").Value = "Floating" Then
Sheets("DCN Master").Rows("27:34").Copy Destination:=Sheets("Print").Cells(Rows.Count, 1).End(xlUp).Offset(1, 0)
End If

If Not IsEmpty(Sheets("DCN Inputs").Range("ProductToggle")) Then
Sheets("DCN Master").Rows("35:74").Copy Destination:=Sheets("Print").Cells(Rows.Count, 1).End(xlUp).Offset(1, 0)
End If

Sheets("Print").Select

On Error Resume Next
Dim obj As Object
Set obj = GetObject(, "Word.Application")
If obj Is Nothing Then
Set obj = CreateObject("Word.Application")
End If
obj.Visible = True


Set objDoc = obj.Documents.Add
a = Sheets("Print").Range("A" & Rows.Count).End(xlUp).Row
Sheets("Print").Range("A1:F" & a).Copy
objDoc.Range.PasteExcelTable False, False, True
objDoc.Activate


Set objTable = objDoc.Tables(1)
With objTable
    .AutoFitBehavior wdAutoFitContent
    .PreferredWidth = 505
    .Range.ParagraphFormat.Alignment = 3
End With
Application.CutCopyMode = False



With objDoc.PageSetup
.TopMargin = Application.InchesToPoints(0.71)
.BottomMargin = Application.InchesToPoints(0.71)
.LeftMargin = Application.InchesToPoints(0.71)
.RightMargin = Application.InchesToPoints(0.71)
End With



With objDoc

.Range.ParagraphFormat.LineSpacingRule = wdLineSpace1pt5
.Range.ParagraphFormat.SpaceAfter = 10

End With


Sheets("DCN Inputs").Select


End Sub

1 answer

  • answered 2018-07-12 07:45 AntiDrondert

    This will color second letter in first cell of first table

    With objDoc.Range.Tables(1).Range.Cells(1).Range
        objDoc.Range(Start:=.Start + 1, _
                     End:=.Start + 2).Font.ColorIndex = 6
    End With
    

    OR

    objDoc.Range.Tables(1).Range.Cells(1).Range.Characters(2).Font.ColorIndex = 6