Duplicate paragraphs except in tables

[jalve]

For translation work, I would like to have a macro that copies each paragraph from the source Word document to a target document twice, using different color font, and then protects the first one of those two occurrences from editing. The proofing language of the second occurrence would be changed to the target language. I would then manually translate the second occurrence, and would have confidence that I don't accidentally change the original text.


I have tried to do this several times, and while it sounds simple, I haven't had much of luck. The problem is, these are complex documents and they include lots of tables, etc., where I get a run-time error 4605 saying the "method is not available because the object refers to the end of table row". I would settle for skipping tables if I even knew how to do that.

Any suggestions?

[gmayor]

The following will address the text paragraphs but not tables. Basically it creates two content controls into which each paragraph is copied. The red paragraphs are not editable.

Sub Macro1()
'Graham Mayor - https://www.gmayor.com - Last updated - 05 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

            Set oRng = oTarget.Range
            oRng.Collapse 0

            Set oCC1 = oTarget.ContentControls.Add(wdContentControlRichText, oRng)
            oCC1.Range.Text = oPara.Range.Text
            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.Text = oPara.Range.Text
            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

[jalve]

Thank you so much, Graham! This is already quite useful!

I need to learn more about the content controls, a new topic for me.


Once I have finished the translation, how do I go about extracting the target language text only?

[gmayor]

You would need another macro to delete the locked red formatted controls, remove the controls from the blue text and reformat as black e.g. as follows

Sub Macro2()
'Graham Mayor - https://www.gmayor.com - Last updated - 06 Mar 2020
Dim oCC As ContentControl
Dim IngCC As Long
Dim oRng As Range
    For IngCC = ActiveDocument.ContentControls.Count To 1 Step -1
        Set oCC = ActiveDocument.ContentControls(IngCC)
        If oCC.LockContents = True Then
            oCC.LockContentControl = False
            oCC.LockContents = False
            oCC.Range.Paragraphs(1).Range.Delete
            oCC.Delete
        Else
            oCC.LockContentControl = False
            oCC.Delete
        End If
    Next IngCC
    Set oRng = ActiveDocument.Range
    oRng.Font.ColorIndex = wdAuto
    With oRng.Find
        Do While .Execute(findText:="^13{2,}", MatchWildcards:=True)
            oRng.Text = Chr(13)
            oRng.ParagraphFormat.SpaceAfter = 12
            oRng.Collapse 0
        Loop
    End With
lbl_Exit:
    Set oRng = Nothing
    Set oCC = Nothing
    Exit Sub
End Sub

[jalve]

Brilliant! Thanks again!

[gmayor]

Given your previous comment there is probably no reason to format the unlocked control as blue text in the first place, so no need also to reformat it as black, should you not do so.

[jalve]

Thanks, I realized that. Actually, I would prefer to keep the styles intact, but I have read that it's not possible with content controls to apply paragraph styles. Would it be possible to use content control only for the protected copy of the paragraph?

[gmayor]

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:

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

[jalve]

This is AWESOME! So the difference is just .FormattedText vs .Text?



I guess I just jumped to conclusions after reading this post:



Different ways to apply a style to a content control - Microsoft Community


Now I see it actually says paragraph styles cannot be applied through the content control properties dialogue, which is not to be confused with macros, right? Cool!



By the way, the point of the different colors was just to make the protected text stand out, so that I won't waste time trying to edit it, that's all.



This will work very well for me, so thanks again! I really appreciate your help.

[jalve]

I have used these macros on several translation projects and they've been useful. However, I keep having a problem with the styles when I extract the translated text. The styles will be applied to wrong paragraphs (it looks like they are off by one). Is there any explanation for this behaviour?

I have added the hidden property for the non-editable text, if that matters.

So far I have just corrected the styles manually in the end, but now I have a huge document, and would like to avoid that, if possible...

[Guessed]

We can't see what you are doing with hidden text. You might need to post a sample document to demonstrate what isn't happening correctly for you.

My interpretation of what you need for both macros is a variation on how Graham has done it. You could give this a try to see if it avoids the offset style issue you are having.

Sub TransPhile()
  Dim oSource As Document, oTarget As Document
  Dim oRng As Range, aTbl As Table, aRow As Row
  Dim oCC1 As ContentControl, oCC2 As ContentControl, i As Integer
  
  Set oSource = ActiveDocument
  oSource.Save
  If oSource.Path = "" Then GoTo lbl_Exit
  Set oTarget = Documents.Add(oSource.FullName)
  
  'Remove existing tables
  For i = oTarget.Tables.Count To 1 Step -1
    oTarget.Tables(i).Range.Rows.ConvertToText Separator:=wdSeparateByParagraphs, NestedTables:=True
  Next i
  
  'Get rid of empty paragraphs
  With oTarget.Range.Find
    .ClearFormatting
    .Replacement.ClearFormatting
    .Text = "[^13]{1,}"
    .Replacement.Text = "^13"
    .Forward = True
    .Wrap = wdFindContinue
    .Format = False
    .MatchCase = False
    .MatchWholeWord = False
    .MatchWildcards = True
    .MatchSoundsLike = False
    .MatchAllWordForms = False
    .Execute Replace:=wdReplaceAll
  End With
  
  'Convert to a table
  Set aTbl = oTarget.Range.ConvertToTable(Separator:=wdSeparateByParagraphs, NumColumns:=1)
  aTbl.Columns.Add BeforeColumn:=aTbl.Columns(1)
  aTbl.PreferredWidthType = wdPreferredWidthPercent
  aTbl.PreferredWidth = 100
  
  For Each aRow In aTbl.Rows
    Set oRng = aRow.Cells(2).Range
    oRng.End = oRng.End - 1
    aRow.Cells(1).Range.FormattedText = oRng.FormattedText
    Set oCC1 = oTarget.ContentControls.Add(wdContentControlRichText, aRow.Range.Cells(1).Range)
    oCC1.Color = wdColorRed
    oCC1.LockContentControl = True
    oCC1.LockContents = True
    Set oCC2 = oTarget.ContentControls.Add(wdContentControlRichText, aRow.Range.Cells(2).Range)
    oCC2.Range.LanguageID = wdEnglishAUS      'set your target language
  Next aRow

lbl_Exit:
  Exit Sub
End Sub

Sub FinishedProduct()
  Dim aCC As ContentControl
  For Each aCC In ActiveDocument.ContentControls
    aCC.LockContentControl = False
    aCC.Delete
  Next aCC
  If ActiveDocument.Tables.Count = 1 Then
    ActiveDocument.Tables(1).Columns(1).Delete
    ActiveDocument.Tables(1).Range.Rows.ConvertToText Separator:=wdSeparateByParagraphs
  End If
End Sub

[jalve]

Thanks, I need to look at those macros when I have more time.


By the hidden property, I meant that just after setting the color for oCC1, I do this:
oCC1.Range.Font.Hidden = True
oCC1.Appearance = wdContentControlHidden


Then I can use the Show/Hide button to see the source language text if I want it, or hide it when I don't need it.


I don't know if this messes things up. I have had similar problems also before these macros, when I manually duplicated paragraphs and then hid one of them, so it could be me who is doing something wrong!

[Guessed]

The macros are not written to run more than once on a file. If you have been editing the macros that were provided, you need to show the code you ARE USING in order to allow someone to tell you what the problem might be. You should also post a sample document that the macro is failing on.

One possible issue is that once a CC is locked, changing attributes such as font.hidden will fail. The CC.Appearance is just hiding the CC box around the object, it isn't important.

[jalve]

I am not running them more than once on a file. Sorry, I can't post the document because of copyright issues.



The document starts with a table of contents, followed by a table of figures, followed by a table of tables. Then there is a page break, and the title of the document, followed by the body of the document. The first sign that something is not right is in the table of contents, which happens to have some code visible like this:

TOC \o "1-3" \h \z \u

This is in the hidden non-editable first line of the table of contents.



Other than that, the styles appear to be okay.


Only after running the second macro to extract the translated text the styles are applied to the wrong paragraphs.



Here's the macro I use before translation:




Sub PrepareForTranslation()
'
' PrepareForTranslation Macro
'

'Graham Mayor - Graham Mayor - Home Page - Last updated - 095 Mar 2020
'Modified by Jukka Alve - Last updated 2021-05-24

Dim oSource As Document, oTarget As Document
Dim oRng As Range
Dim oPara As Paragraph
Dim oCC1 As ContentControl, oCC2 As ContentControl
ActiveDocument.Range.ListFormat.ConvertNumbersToTe xt
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(wdContentControlRichTe xt, oRng)
oCC1.Range.FormattedText = oPara.Range.FormattedText
oCC1.Range.Font.ColorIndex = wdBlue
oCC1.Range.Font.Hidden = True
oCC1.Appearance = wdContentControlHidden
oCC1.LockContentControl = True
oCC1.LockContents = True


Set oRng = oTarget.Range
oRng.Collapse 0

Set oCC2 = oTarget.ContentControls.Add(wdContentControlRichTe xt, oRng)
oCC2.Range.FormattedText = oPara.Range.FormattedText
oCC2.LockContentControl = True
End If
DoEvents
Next oPara
oTarget.Save
oTarget.Paragraphs(1).Range.Delete
lbl_Exit:
Set oSource = Nothing
Set oTarget = Nothing
Set oRng = Nothing
Set oPara = Nothing
Exit Sub
End Sub




The one I use after translation is identical to Graham's Macro2.

[jalve]

I think you're on the right track!


I made some progress myself in the meantime. I commented out the part in Graham's second macro which I didn't understand:


' With oRng.Find
' Do While .Execute(findText:="^13{2,}", MatchWildcards:=True)
' oRng.Text = Chr(13)
' oRng.ParagraphFormat.SpaceAfter = 12
' oRng.Collapse 0
' Loop
' End With



After running the second macro without those lines, I ended up with a document that has the styles applied to correct paragraphs, but with lots of empty paragraphs. So, I suppose those lines are intended to remove the empty paragraphs, but they also do something to mess up the styles.