PDA

View Full Version : Combine multiple word paragraphs into single paragraph variable



gauss76
02-13-2017, 02:20 AM
Hi,

I have a word document containing multiple paragraphs. I can loop through the individual paragraphs using the following code

Dim pnew As Paragraph
Dim p As Paragraph
For Each p In ActiveDocument.Paragraphs
'
' Do some stuff with the paragraphs in here
'
Next p

I can also use the st command to set a paragraph to another paragraph variable with

Set pnew = ActiveDocument.Paragraphs(1)

However, what I really want to do is loop through the paragraphs and after each loop, assuming certain conditions are met, add the contents of the paragraph p into the new paragraph pnew so at the end of the loop pnew contains all the paragraphs of the document,which satisfied the required conditions, in a single paragraph variable pnew.

Any help much appreciated.

Gauss76

gmayor
02-13-2017, 05:27 AM
From your description it appears that you need to write the paragraphs to a string variable e.g.


Dim strParaNew As String
Dim oRng As Range
Dim oPara As Paragraph
strParaNew = ""
For Each oPara In ActiveDocument.Paragraphs
'
' Do some stuff with the paragraphs in here
'
Set oRng = oPara.Range
oRng.End = oRng.End - 1
strParaNew = strParaNew & oRng.Text & Chr(32)
Next oPara
'Do something with the string e.g.
ActiveDocument.Range.InsertAfter strParaNew

gmaxey
02-13-2017, 05:30 AM
Something like this perhaps:


Sub ScratchMacro()
'A basic Word macro coded by Greg Maxey
Dim oPar As Paragraph
Dim oCol As New Collection
Dim lngIndex As Long
Dim oDoc As Document
Set oPar = ActiveDocument.Paragraphs(1)
Do
If Len(oPar.Range.Text) > 3 Then oCol.Add oPar.Range.Duplicate
If oPar.Range.End = ActiveDocument.Range.End Then Exit Do
Set oPar = oPar.Next
Loop
Set oDoc = Documents.Add
For lngIndex = 1 To oCol.Count
oDoc.Range.InsertAfter oCol.Item(lngIndex).Text
Next lngIndex
lbl_Exit:
Exit Sub
End Sub

gauss76
02-13-2017, 05:46 AM
Thanks to gmayor and gmaxey for the replies...However, their solutions both lose the formatting of the original paragraphs... Reading my original post, I forgot to mention the most important aspect of my problem.

What I really need to do is preserve the formatting of the original paragraphs. Converting to text is no good as all formatting is lost. That is why I had the idea of creating a new variable of type paragraph so formatting would be included. However I cannot find a way of adding a paragraph to an already existing paragraph variable, if that makes sense.

Apologies for the intial incomplete post.

gauss76

gmaxey
02-13-2017, 02:33 PM
Sub ScratchMacro()
'A basic Word macro coded by Greg Maxey
Dim oPar As Paragraph
Dim oCol As New Collection
Dim lngIndex As Long
Dim oDoc As Document, oRng As Range
Set oPar = ActiveDocument.Paragraphs(1)
Do
If Len(oPar.Range.Text) > 3 Then oCol.Add oPar.Range.FormattedText
If oPar.Range.End = ActiveDocument.Range.End Then Exit Do
Set oPar = oPar.Next
Loop
Set oDoc = Documents.Add
For lngIndex = 1 To oCol.Count
Set oRng = oDoc.Range
oRng.Collapse wdCollapseEnd
oRng.FormattedText = oCol.Item(lngIndex).FormattedText
Next lngIndex
lbl_Exit:
Exit Sub
End Sub

gmayor
02-14-2017, 12:14 AM
String variables of the type that Greg and I suggested (in the absence of the complete picture) do not of course carry formatting. If you want formatting then you need to tell us what you wish to do with the target paragraphs. You could add them at the end, or as Greg has suggested in another document, however with Greg's suggestion I would have used the original document as template to ensure the formatting remains the same. e.g.


Set oDoc = Documents.Add(Template:=ActiveDocument.FullName)
oDoc.Range.Text = ""
For lngIndex = 1 To oCol.Count
Set oRng = oDoc.Range
oRng.Collapse wdCollapseEnd
oRng.FormattedText = oCol.Item(lngIndex).FormattedText
Next lngIndex
This assumes the original document has been saved at least once.

gauss76
02-14-2017, 01:39 AM
Thanks again for the suggestions, that's a big help. What I want to do with the combined paragraphs is to place them in a single Excel Cell while preserving the formatting (any multiple paragraphs will always by less than the character limit for an Excel cell).

gauss76

gmayor
02-15-2017, 12:28 AM
Copying from Word to Excel is a pain as the formats are entirely different. In Word, the paragraph breaks hold the paragraph format, whereas in Excel they force a new cell. It is not easy to reconcile the two (though you could ask those who have more Excel knowledge).

However the following is going to be close to what you want.

Sub Macro1()
Dim oRng As Range
Dim oDoc As Document
Dim oTemp As Document
Dim oPara As Paragraph
Dim oTempRng As Range
Dim xlApp As Object
Dim xlBook As Object
Dim xlSheet As Object
Set oDoc = ActiveDocument
Set oTemp = Documents.Add(Template:=ActiveDocument.FullName)
Set oTempRng = oTemp.Range
oTempRng.Text = ""
For Each oPara In oDoc.Paragraphs
'
' Do some stuff with the paragraphs in here
'
Set oRng = oPara.Range
oRng.End = oRng.End - 1
oTempRng.Collapse 0
oTempRng.FormattedText = oRng.FormattedText
Next oPara
Set oTempRng = oTemp.Range
oTempRng.End = oTempRng.End - 1
oTempRng.Copy
On Error Resume Next
Set xlApp = GetObject(, "Excel.Application")
If Err Then
Set xlApp = CreateObject("Excel.Application")
End If
On Error GoTo 0
Set xlBook = xlApp.Workbooks.Add
'Set xlbook = xlApp.workbooks.Open(FileName:=strWorkbookname)
xlApp.Visible = True
Set xlSheet = xlBook.Sheets(1)
xlSheet.Range("A1").Activate
xlSheet.Paste
oTemp.Close 0
lbl_Exit:
Exit Sub
End Sub

gmaxey
02-15-2017, 06:07 AM
Graham,

It looks like you have and extra line of code that is a detriment vice advantage:


Sub Macro1()
Dim oRng As Range
Dim oDoc As Document, oTemp As Document
Dim oPara As Paragraph
Dim oTempRng As Range
Dim xlApp As Object, xlBook As Object, xlSheet As Object
Set oDoc = ActiveDocument
Set oTemp = Documents.Add(Template:=ActiveDocument.FullName)
Set oTempRng = oTemp.Range
oTempRng.Text = ""
For Each oPara In oDoc.Paragraphs
'Do some stuff with the paragraphs in here
Set oRng = oPara.Range
'oRng.End = oRng.End - 1 'Graham using this line, you loose any paragraph level formatting
oTempRng.Collapse 0
oTempRng.FormattedText = oRng.FormattedText
Next oPara
Set oTempRng = oTemp.Range
oTempRng.End = oTempRng.End - 1
oTempRng.Copy
On Error Resume Next
Set xlApp = GetObject(, "Excel.Application")
If Err Then
Set xlApp = CreateObject("Excel.Application")
End If
On Error GoTo 0
Set xlBook = xlApp.Workbooks.Add
'Set xlbook = xlApp.workbooks.Open(FileName:=strWorkbookname)
xlApp.Visible = True
Set xlSheet = xlBook.Sheets(1)
xlSheet.Range("A1").Activate
xlSheet.Paste
oTemp.Close 0
lbl_Exit:
Exit Sub
End Sub

gmayor
02-15-2017, 07:05 AM
Greg
That was intentional. Excel doesn't support the Word paragraph formatting and leaving then end-of-paragraph character in will paste the paragraphs in separate cells. I don't see any way to retain the paragraph breaks and copy all to the same cell AND retain the paragraph format, but I am open to suggestions if your Excel knowledge is better than mine (which would not be difficult :)).

gmaxey
02-15-2017, 08:24 AM
Graham,

Ok I missed the part about copying to a single cell. Without doing it as modified above and then creating some sort of lengthy Excel Macro to merge each formatted character in the resulting cells to a single cell, I don't see a way to do it either. Even then, you wouldn't preserve non-font formatting.