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