Strange visualization error after copying paragraphs from one document to another

LucaA · #1 06-29-2023, 02:56 AM

Hi

I'm trying to copy-pasting some paragraphs from a table in one document into another document.

Let me show with some images what I want to achieve. I have a template document like this:

and a document containing a list of services descriptions like this:

and I would like to obtain this:

Note that in the final version the source document will contain a list with several services and I want to copy only a subset of these in an arbitrary order.

I wrote this code:

Code:

Sub AddServicesIntro(services() As Variant)
    Dim sourceDoc As Document
    Dim targetDoc As Document
    Dim targetText As Range
    Dim sourceText As Range
    Dim sourceTable As Table
    Dim sourceRow As row
    Dim previousLeftIndent As Single
    
    ' Open the source and target documents
    Set sourceDoc = Documents.Open("C:\Users\002016\Offline workspace\ServiceSummaryData.docx")
    Set targetDoc = Documents.Open("C:\Users\002016\Offline workspace\test.docm")
    Set targetText = targetDoc.Content
    
    ' Assuming the tables are the first tables in their respective documents
    Set sourceTable = sourceDoc.Tables(1)
    
    
    With targetText.Find
        .text = "<SERVICES DESCRIPTIONS>"
        .Replacement.text = ""
        .Execute Replace:=wdReplaceAll
        If .Found Then
            ' Move the target range after the found sentence
            targetText.Collapse Direction:=wdCollapseEnd
            
            ' Store original paragraph indent
            previousLeftIndent = targetText.ParagraphFormat.LeftIndent
            
            ' Add a new paragraph after the target sentence
            targetText.InsertParagraphAfter
            
            ' Iterate for each service
            For Each serviceName In services
                'Skip blanks
                If serviceName <> "" Then
                    ' Seach the serviceName
                    For Each sourceRow In sourceTable.Rows
                        ' When found, copy the row
                        If ClearText(sourceRow.Cells.Item(1).Range.text) = serviceName Then
                            ' Move the target range to the end of the new paragraph
                            targetText.MoveEnd wdParagraph, 1
                            
                            ' Copy the first row of the source table
                            Set sourceText = sourceRow.Cells(2).Range.FormattedText
                            
                            ' Add the new paragraph
                            targetText.Collapse Direction:=wdCollapseEnd
                            targetText.FormattedText = sourceText.FormattedText
                            
                            ' Adjust paragraph left indent of sourceText
                            targetText.ParagraphFormat.LeftIndent = previousLeftIndent + CentimetersToPoints(2 * 0.63)
                            
                            ' Go to Next service
                            Exit For
                        End If
                    Next sourceRow
                End If
            Next serviceName
        End If
    End With
   
    ' Close source document
    sourceDoc.Close
End Sub

Function ClearText(text As String) As String
    text = Replace(text, Chr(7), "")
    text = Replace(text, Chr(10), "")
    text = Replace(text, Chr(13), "")
    ClearText = text
End Function

Sub Test()
    Dim services() As Variant
    
    services = Array("Service 1", _
                     "Service 2")
    AddServicesIntro services
End Sub

The cose works "somehow", but after running it the output doesn't look as I'd expect. More precisely, the output looks like this:

Note that the "Service 2" paragraph is displayed twice.
What's weird is that the text is not actually present twice, but it's like if a single portion of text was shown twice. Indeed, if I modify one of the two instances of this paragraph, for example adding some words in it, both instances are modified.

This image should explain what I mean:

As you can see the "XXXXXXX" text was added only in the bottom instance, but it's like if I was typing in two places at the same time.

When I save, a warning is shown saying "Errors were detected in this file, but Word was able to same the file by making repairs. Click Details to see more information on the repairs made."

After this, the error is fixed and I obtain the output I would expect.

While this "works", it's clearly unconvenient to produce a corrupted file and then hoping Word to fix it.

I suspect that this is related to an ASCII character 7 that gets copied at the end of each paragraph (you can see it in the screenshots above as the white rectangle character before the new line).
I tryied to remove it from the formattet text before copying it, but this messes up with the formatting of the paragraph that become all bold.

Do you have any suggestions on how to fix this?

I attached the two files if you want to have a look at them

Many thanks
Luca

Guessed · #2 07-01-2023, 06:45 PM

You can't copy the complete contents of a cell into a non-table. The complete contents of a cell includes the invisible end-of-cell marker as well as an invisible paragraph mark.

To fix this, try modifying this chunk

Code:

' Copy the first row of the source table
Set sourceText = sourceRow.Cells(2).Range   'Note I removed the formattedtext from here
sourceText.End = sourceText.End - 1   'or 2 if you don't want the paragraph mark either
' Add the new paragraph
targetText.Collapse Direction:=wdCollapseEnd
targetText.FormattedText = sourceText.FormattedText

Similar Threads
Thread	Thread Starter	Forum	Replies	Last Post
Visualization with MS Project	idole	Project	0	11-07-2018 12:46 AM
Copying paragraphs from multiple documents to the current one.	paik1002	Word VBA	3	02-22-2016 04:03 AM
Two visualization with the same file	bobparr	PowerPoint	1	01-11-2015 09:22 AM
strange grayed out line prevents copying or deletion after endnotes	JerryL	Word	1	02-09-2014 08:59 AM
Strange error mesage	andrew6800	Outlook	2	01-23-2011 06:02 PM