Microsoft Office Forums - View Single Post - [Solved] Duplicate paragraphs except in tables

gmayor · 03-09-2020, 05:26 AM

You read wrong. It is entirely possible to use styles. If you want to keep the styles then use the following code, though this rather negates the point of using coloured text, so I have only coloured the locked control content:

Code:

Sub Macro1()
'Graham Mayor - https://www.gmayor.com - Last updated - 095 Mar 2020
Dim oSource As Document, oTarget As Document
Dim oRng As Range
Dim oPara As Paragraph
Dim oCC1 As ContentControl, oCC2 As ContentControl
    Set oSource = ActiveDocument
    oSource.Save
    If oSource.Path = "" Then GoTo lbl_Exit
    Set oTarget = Documents.Add(oSource.FullName)
    oTarget.Range.Text = vbCr
    For Each oPara In oSource.Paragraphs
        If oPara.Range.Information(wdWithInTable) = False And Len(oPara.Range) > 1 Then
            'oPara.Range.Copy
            Set oRng = oTarget.Range
            oRng.Collapse 0

            Set oCC1 = oTarget.ContentControls.Add(wdContentControlRichText, oRng)
            oCC1.Range.FormattedText = oPara.Range.FormattedText
            oCC1.Range.Font.ColorIndex = wdRed
            oCC1.LockContentControl = True
            oCC1.LockContents = True

            Set oRng = oTarget.Range
            oRng.Collapse 0

            Set oCC2 = oTarget.ContentControls.Add(wdContentControlRichText, oRng)
            oCC2.Range.FormattedText = oPara.Range.FormattedText
            'oCC2.Range.Font.ColorIndex = wdBlue
            oCC2.LockContentControl = True
        End If
    Next oPara
    oTarget.Paragraphs(1).Range.Delete
lbl_Exit:
    Set oSource = Nothing
    Set oTarget = Nothing
    Set oRng = Nothing
    Set oPara = Nothing
    Exit Sub
End Sub