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 WithOR
objDoc.Range.Tables(1).Range.Cells(1).Range.Characters(2).Font.ColorIndex = 6