![]() |
#11
|
||||
|
||||
![]()
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. Code:
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
__________________
Andrew Lockton Chrysalis Design, Melbourne Australia |
Tags |
4605, copy/paste paragraph, tables |
|
![]() |
||||
Thread | Thread Starter | Forum | Replies | Last Post |
![]() |
moorea21 | Word | 4 | 11-01-2018 12:53 PM |
![]() |
iamgator | Word VBA | 5 | 12-27-2016 01:34 AM |
![]() |
AaaTeX | Word Tables | 3 | 08-03-2014 07:00 PM |
Show & hide paragraphs, parts of tables, etc | Preloader | Word | 2 | 10-19-2013 02:37 PM |
![]() |
pgwolfe | Word | 3 | 09-24-2013 07:58 PM |