Solved: Pre-print page formatting function

[Dave]

This is XL VBA but my objective is a Word endeavour. Perhaps someone already has a wheel made for me, and who knows perhaps some native Word code might achieve my objective, but I am trying to make a function in XL VBA which would page format a Word doc. The Word doc contains "sections" seperated by blank line(s). Each section contains more than 1 line and is usually 4 or 8 lines seperated by 2 blank lines between sections. The doc may contain none or lots of sections. The sections may start on 1 page and end on another. Therein lies the problem. The format objective is: starting from the beginning of the doc, re-space sections with a specified spacing until a section lies across 2 pages, then add a header with page numbering to the start of the next page and move the offending section forward onto that page. This would all be done before the doc is made visible. For the purpose of testing, the following code makes the doc visible to see if the code worked. The difficult parts...
how to loop through the doc, determine the section size, move each section with re-spacing, determine if the section crosses 2 pages and if so move the section and remaining doc forward after inserting the header? Seemed like a Saturday project if anyones interested. Dave
ps. I "may" be able to post a sample doc if need be

The code so far...

Option Explicit
Public Function PrePrint(Header As String, Spacing As Integer)
'Header = Name Text of doc grouping ie "Widgets 2007"
'Spacing = number of lines between sections
'No Word reference
'formats pages for printing...
'while keeping sections intact
'header and page numbering
'format determined by spacing/page length nds
Dim FName As String
Dim Wdapp As Object, Cnt As Integer

'alter file name as needed
FName = "C:\records\summary.doc"
On Error GoTo ErFix
Set Wdapp = CreateObject("Word.Application")
Wdapp.documents.Open Filename:=FName

'add 1st section
'add header or spacing & 2nd section based on...
'length of next section
On Error GoTo ErFix2
With Wdapp.Selection

'code for spacing...
'For Cnt = 1 To Spacing
'.TypeParagraph
'Next Cnt

'code for header insertion...
'.content.insertafter Header

End With
'*for test only
Wdapp.Visible = True
'*for test only
'Wdapp.activedocument.Close savechanges:=True
'Wdapp.Quit
Set Wdapp = Nothing
Exit Function
ErFix:
On Error GoTo 0
MsgBox "File error"
Wdapp.Quit
Set Wdapp = Nothing
Exit Function
ErFix2:
On Error GoTo 0
MsgBox "Format error"
Wdapp.Quit
Set Wdapp = Nothing
End Function

[fumei]

Could you please describe this again? I am trying to follow, and I am trying to figure out WHY you are trying to do this.

First of all, "Section" is a very specific term in Word. Are these...ummm, "chunks" separated by Section breaks?

I am trying to understand why you WANT a chunk to cross a page.

I am trying to udnerstand why this document may, or may not, have X number of chunks. I am trying to understand if these chunks have text in them or not.

If you could give an explanation of what, and why, it may help. Why are you not (I think) using a template? It also sounds like you could use Styles.

[Dave]

Thanks Gerry for your interest. My use of "section" was as I tried to define it ("Each section contains more than 1 line and is usually 4 or 8 lines seperated by 2 blank lines between sections"). As you suspected, the sections are chunks always with text or the chunk doesn't exist. I don't want a chunk across a page, my objective is to remove this problem. The doc is generated with XL VBA and I give up on trying to format the doc as it is being constructed. I also thought a more useful approach would be to format the completed doc with a routine that could manage variable section length and section spaces. I guess my question assumes that the input doc is unkown and the routine will page format the doc. I'm having a bit of success with the code for this (read: still a long way off) but I certainly am looking forward to fixing this problem with any input offerred. Again, thanks for your time. Dave

[fumei]

Lines is a bit of a funny word, in Word. Let me see if I have this.

A chunk can be a single paragraph, or more than one paragraph? Perhaps if you turn on Show/Hide. Tell me about the pilcrows, those funny things at the end of paragraphs.

If I have this right, you have a paragraphs (or more) followed by TWO blanks paragraphs - what you are calling "lines".

variable section length and section spaces.If it is not a Section - it uses a section break - please do not use "section".

So....what separates these "sections"? These chunks? Simply the "blank lines" - which I am assuming are actually paragraphs?

How are these chunks being put into the document? Pasted from Excel?

Is it possible for you to dummy up a Word document showing what you WANT it to look like? It would also help if you had one that is NOT the way you want it to look like. If you can, do that and post them.

[Dave]

Hello Gerry. My Word lingo isn't up to speed but I'm slowly learning. I still really don't have a good grasp if there is a difference between a single line and a paragraph. For clarity purposes in this thread, you are again right, the lines I referred to are all paragraphs (containing 1 line). These single line paragraphs are grouped together in what I will from now on call "chunks". These chunks may contain only 1 paragraph (ie. existing header) or have multiple paragraphs. Each chunk is seperated by a blank paragraph(s). Anyways, I've made abit of progress with some code to start with. There is still quite aways to go. This code will respace the doc and detect when something should be done (ie add header). Problem is it doesn't actually add the header yet. I was able to dummy up a test doc which I reformatted with irregular spacing between chunks just for testing purposes. Hopefully it will attach and be somewhat useful if you or anyone else wants to give it a try. Any suggestions for code improvement would be welcomed. Thanks again for your time. Dave

module code....

Option Explicit
Public Function PrePrint(Header As String, Spacing As Integer)
'Header = Name Text of doc grouping ie "Widgets 2007"
'Spacing = number of lines between chunks
'No Word reference
'formats pages for printing.
'Adds spacing, header and page #'s
'keeps "chunks" of para data intact
'chunks are 1 or more paras seperated by a blank para
'paragraphs are 1 line only
'adds header and page numbering (some day.. not this version)
Dim FName As String, Mydata As String, StrCnt As Integer
Dim Mydata2 As String, Bigstring As String
Dim Wdapp As Object, Cnt As Integer, Last As Integer
Dim Myrange As Variant, Cnt4 As Integer
Dim Myrange2 As Variant, Cnt2 As Integer, Cnt3 As Integer
'alter file name as needed
FName = "C:\testsummary.doc"
'file error
On Error GoTo ErFix
'open doc and select
Set Wdapp = CreateObject("Word.Application")
Wdapp.documents.Open Filename:=FName
Wdapp.ActiveDocument.Select
'doc manipulation error
On Error GoTo ErFix2
With Wdapp.Selection
Cnt = 1 'para counter in actual doc
Last = Wdapp.Selection.Paragraphs.Count
StrCnt = 1 ' para counter in big string
'loop through doc paragraphs
Do
Mydata = vbNullString
'check for data in para
Set Myrange = Wdapp.ActiveDocument.Paragraphs(Cnt).Range
Myrange.SetRange start:=Myrange.start, _
End:=Wdapp.ActiveDocument.Paragraphs(Cnt).Range.End
'change range to string for testing
Myrange.Select
Mydata = Wdapp.Selection.Text
'if data found continue...
'..else loop to next para ie.(cnt + 1)
If Len(Mydata) <> 1 Then
'find next blank para ie. Ubound of "chunk" is cnt2 - 1
For Cnt2 = Cnt To Last
Mydata2 = vbNullString
Set Myrange2 = Wdapp.ActiveDocument.Paragraphs(Cnt2).Range
Myrange2.SetRange start:=Myrange2.start, _
End:=Wdapp.ActiveDocument.Paragraphs(Cnt2).Range.End
'change range to string for testing
Myrange2.Select
Mydata2 = Wdapp.Selection.Text
'if blank para then "Chunk" complete
If Len(Mydata2) = 1 Then
Mydata2 = vbNullString
'add spacing FOLLOWING chunk
For Cnt3 = 1 To Spacing
.TypeParagraph
Next Cnt3
'reset last re. adding spacing
Wdapp.ActiveDocument.Select
Last = Wdapp.Selection.Paragraphs.Count
'set size of "chunk" to include new range including...
'...spacing (ie. cnt to cn2 - 1 + spacing)
Set Myrange2 = Wdapp.ActiveDocument.Paragraphs(Cnt).Range
Myrange2.SetRange start:=Myrange2.start, _
End:=Wdapp.ActiveDocument.Paragraphs(Cnt2 - 1 + Spacing).Range.End
'avoid doc start error
If Cnt <> 1 Then
'location within bigstring of last para added
StrCnt = StrCnt + ((Cnt2 - 1 + Spacing) - Cnt) + 1
'check to see if chunk addition would cross end of page in bigstring
'for chunk range: next para (strcnt +1) to last para
For Cnt4 = StrCnt + 1 To (StrCnt + 1 + ((Cnt2 - 1 + Spacing) - Cnt))
'if strcnt/46=0 then end of page for chunk in bigstring
If Cnt4 Mod 46 = 0 Then
MsgBox "Last line of page in bigstring at para: " & _
Cnt4 & vbCrLf _
& "Start Paragraph in bigstring: " & StrCnt + 1 & vbCrLf _
& "Last Paragraph in bigstring: " & _
(StrCnt + 1 + ((Cnt2 - 1 + Spacing) - Cnt))
'*****stuff to do here**********
'only if data in "Chunk" crosses page line...
'screen false positives ie. spacing across page
'add spaces/move range downward on doc
'make header with page number
'add header and spacing
're-adjust cnt and last
'reset rng to include changes...
'..then convert to string and add to bigstring
End If
Next Cnt4

Else
'doc header and spacing add to bigstring cnt
StrCnt = StrCnt + Spacing
End If
'next para location to search based on respacing
'this will change with changes to "****stuff" above
Cnt = Cnt + ((Cnt2 - 1 + Spacing) - Cnt) + 1
'make rng into string and add to big string for output
Myrange2.Select
Mydata2 = Wdapp.Selection.Text
Bigstring = Bigstring + Mydata2
Exit For
End If
Next Cnt2
Else
'move to next para re. blank para
Cnt = Cnt + 1
End If
Loop Until Cnt >= Last
'clear doc contents and replace with string
With Wdapp.ActiveDocument
.Range(0, .Characters.Count).Delete
.content.insertafter Bigstring
End With
End With
'**show doc for testing only
Wdapp.Visible = True
'save doc changes
'**commented for testing only
'Wdapp.activedocument.Close savechanges:=True
'Wdapp.Quit
Set Wdapp = Nothing
Exit Function
ErFix:
On Error GoTo 0
MsgBox "File error"
Wdapp.Quit
Set Wdapp = Nothing
Exit Function
ErFix2:
On Error GoTo 0
MsgBox "Format error"
Wdapp.Quit
Set Wdapp = Nothing
End Function


This to test...

Sub TestFx()
Dim Temp As Integer
Temp = Application.InputBox("Enter Spacing")
Call PrePrint("No Header Yet", Temp)
End Sub

[fumei]

OK, I am looking at the code, and the document. It will take a little time, but I will make some comments immediately.

1. You are making Selections.Wdapp.ActiveDocument.SelectThis is to be avoided as much as possible. For most cases it is NOT needed.

2. You are looping through the document paragraphs. Nothing wrong with that, but you are doing it by counting them! Plus, you are using redundant instructions for the range of each.' instruction 1
Set Myrange = Wdapp.ActiveDocument.Paragraphs(Cnt).Range

' instruction 2
Myrange.SetRange start:=Myrange.start, _
End:=Wdapp.ActiveDocument.Paragraphs(Cnt).Range.End These are indentical.

Setting myRange = paragraph.range MAKES the start and end of the range, the start and end of the paragraph range. Why are you then setting the end to be...the end? It is already the End.

3. Use objects!!! You are, again, counting through the paragraphs.Dim oPara As Word.Paragraph
For Each oPara in Wdapp.ActiveDocument.Paragraphs
' do stuff on each paragraph
Nextwill process instructions for each and every paragraph. There is no need to do that counting at all.

4. Further, by using objects there is no need to select each paragraph, then set a string variable to be that selected text.Dim oPara As Word.Paragraph
For Each oPara in Wdapp.ActiveDocument.Paragraphs
If oPara.Range.Text = Chr(13) Then
' that MEANS the paragraph is ONLY a paragraph mark
' that is, it is blank.
' do something, or not
Else ' the paragraph DOES have text
' do something else
End if
Next

What I am saying is that code such as:Myrange.Select
Mydata = Wdapp.Selection.Text is absolutely not needed at all. No need to make all the range Sets, no need to select each range. You can action each paragraph directly by using the Paragraph collection.

OK. I am not sure what "Spacing" is for. As in:For Cnt3 = 1 To Spacing
.TypeParagraph
Next Cnt3

Things would go much better if you used proper styles. Paragraphs can have space between them with out using those "extra" spaces (the extraneous paragraph marks).

I am not sure what you mean precisely as "header", as in:
'make header with page number
'add header and spacingAre you talking about a real header, or TEXT in the document.

Real headers are that area at the top of each page that are independent of the text on the page.

In your document you have:

2006 InFIELD EXPENSE SUMMARY TOTAL EXPENSE: 124825.22

Is this something you want at the top of each page?

You mention in the comments of your code "make header with page number", but I don't see you actually doing that.

Finally, I am looking at the document attached. I notice that there is one chunk of text that DOES cross over onto another page. Here is what I did.

I created a Style named "KeepItTogether". It has the paragraph attributes set to:

Keep With Next
Keep Lines Together

This means any lines within the paragraphs are kept together and will not allow a page break to separate them, AND the paragraph will be kept with the next paragraph.

Then I ran the following:Sub NoPageOverlap()
Dim oPara As Word.Paragraph
For Each oPara In ActiveDocument.Paragraphs
If oPara.Range.Text <> Chr(13) Then
oPara.Style = "KeepItTogether"
End If
Next
End SubSo....

For Each paragraph, if it is NOT blank, assign the Style KeepItTogether to it.

The result? Two results.

1. All chunks of text are kept together - as they are separated by blank paragraphs that do NOT have Keep together attributes.

2. All of those chunks will insist on being on the same page. NO page breaks will occur anywhere in those "Keep together" chunks.

I am attaching your document back - renamed TestSummary_Gerry.doc. I have added a macro button on the top toolbar - "No Page Overlap". Go find a chunk that does cross a page. Then click No Page Overlap.

This obviously does not solve all your issues, but it may demonstrate some other avenues.

[fumei]

Just to add to this....

Attached is a later version. I added two other Styles.

"MyTitle" is for the first paragraph, which looks like a title to me.

"KeepItTogether2" is like "KeepItTogether" EXCEPT:

1. it is ONLY used for the last paragraph of each chunk;

2. it does NOT use Keep with next.

Why do this? KeepItTogether2 uses the same format as KeepItTogether, but has space included after it (24pts). Using it keeps it with the other text paragraphs, but adds space. This way, applying the style still keeps the chunk together, but eliminates the need for all those "empty" paragraphs, which are being used to put space between chunks. NOT having it keep with next means it is not linked to the following paragraph - as it is the last paragraph of the chunk.

This is what Styles are for. You do not need those "extra" paragraphs. Space between paragraphs can be built-in. In fact, having "empty" paragraphs is bad, bad, bad.

So open the attached and run the macro No Page Overlap again - it is on the top toolbar.

The "title" line has its own style - including space after.

Each chunk paragraph has its style as KeepItTogether, except for the last paragraph of th chunk, which ahs the style KeepItTogether2.

Notice the space between chunks is consistent (your original is not, some have three spaces, some have four), and everything is kept together, AND kept to a page, AND there are no extra paragraphs marks at all.

Now, I had to do this by hard-coding some text, but you get the idea....I hope.Sub NoPageOverlap()
Dim oPara As Word.Paragraph
For Each oPara In ActiveDocument.Paragraphs
If oPara.Range.Text <> Chr(13) Then
Select Case Left(oPara.Range.Text, 5)
Case "2006 "
oPara.Style = "MyTitle"
Case "Gross"
oPara.Style = "KeepItTogether2"
Case Else
oPara.Style = "KeepItTogether"
End Select
Else
oPara.Range.Delete
End If
Next
End SubThe logic flow is:

For Each paragraph

If it is NOT blank, check the first first characters.
If they are "2006 " - make the paragraph style MyTitle
If they are "Gross" - make the paragraph style KeepItTogether2
Otherwise, make the paragraph style KeepItTogether

If it IS blank, delete it.

[Dave]

Gerry I very much appreciate your time and assistance but "This is XL VBA but my objective is a Word endeavour". "Dim oPara As Word.Paragraph " is not available without a reference to Word, which I do not want to make, but wasn't very clear on. The doc is generated by XL VBA and its' composition is always changing so I'm not sure how using styles within Word VBA and hardcoding anything would work. I guess I'm not looking for Word VBA and perhaps should have posted to the XL forum? The doc I posted was a sample doc which I purposely re-formatted with irregular spacing for testing purposes. The objective is to re-space this doc as specified while adding a "header" and ensuring that "chunks" do not cross a page line. The "header" it appears I have again misnamed. It will be a 1 line paragraph at the top of page 2 and onward which contains a string passed to the function (along with a page number). If you place the code I posted in an XL module, you will find that it re-spaces the test doc and identifies the areas that may need a "header". The basic notion is that the original doc is used to create a string containing the re-formatted doc. The original doc is cleared upon re-formatting completion and the completed formatted string is inserted in the doc in its' place. The inclusion of blank paragraphs within the string produces blank lines on final output. Apologies for the confusion. Dave

[fumei]

You can still do it. From XL:
Dim Wdapp As Object
Dim oPara As Object
Set Wdapp = CreateObject("Word.Application")
Wdapp.documents.Open Filename:="c:\testexcel.doc"
Wdapp.Visible = True

For Each oPara In Wdapp.Activedocument.Paragraphs
oPara.Style = "NewTest"
Nextallows you to use an paragraph object in a For Each loop, and use .Style for that object.

I am still confused as to "header". If it is something that is going to be on every page from page 2 onwards, then it should BE a header, and put IN the header.

Everything I see here points strongly towards using a Word .DOT template file. Reformatting original documents is messy. A properly formatted template file, with specific styles, would be much, much better.

[Dave]

After hours of mind numbing trial and error I've arrived at a fairly lengthy solution which I will post in the event that it has some general utility for others to use. I will mark this thread as solved but if anyone has a simpler solution I would very much appreciate your posting. Again, thanks Gerry for your efforts. Dave

Place in XL module...

Option Explicit
Public Function PrePrint(Header As String, Spacing As Integer)
'Header = Name Text of doc grouping ie "Widgets 2007"
'Spacing = number of lines between chunks

'place code in XL VBA
'No Word reference required
'formats doc for printing within string (Bigstring)
'Adds spacing & header with page #'s
'keeps "chunks" of para data intact
'chunks are 1 or more paras seperated by a blank para
'paragraphs are 1 line only

Dim FName As String, Mydata As String, StrCnt As Integer
Dim Mydata2 As String, Bigstring As String, Mydata3 As String
Dim Wdapp As Object, Cnt As Integer, Last As Integer
Dim Myrange As Variant, Cnt4 As Integer, Cnt5 As Integer
Dim Myrange2 As Variant, Cnt2 As Integer, Cnt3 As Integer
Dim CheckA As Boolean, CheckB As Boolean, Myrange3 As Variant
Dim Cnt6 As Integer

'alter file name as needed
FName = "C:\testsummary.doc"
'file error
On Error GoTo ErFix

'open doc and select contents
Set Wdapp = CreateObject("Word.Application")
Wdapp.documents.Open Filename:=FName
Wdapp.ActiveDocument.Select

'doc manipulation error
On Error GoTo ErFix2
With Wdapp.Selection
Cnt = 1 'para counter in actual doc
StrCnt = 0 ' para counter in big string
Last = Wdapp.Selection.Paragraphs.Count

'loop through doc paragraphs
ReLoop:
Do Until Cnt >= Last

'check for data in para
Set Myrange = Wdapp.ActiveDocument.Paragraphs(Cnt).Range
Myrange.SetRange Start:=Myrange.Start, _
End:=Wdapp.ActiveDocument.Paragraphs(Cnt).Range.End
'change range to string for testing
Myrange.Select
Mydata = Wdapp.Selection.Text

'if data found continue...
'..else loop to next para ie.(cnt + 1)
If Len(Mydata) <> 1 Then

'find next blank para ie. Ubound of "chunk" is cnt2 - 1
For Cnt2 = Cnt To Last
Set Myrange2 = Wdapp.ActiveDocument.Paragraphs(Cnt2).Range
Myrange2.SetRange Start:=Myrange2.Start, _
End:=Wdapp.ActiveDocument.Paragraphs(Cnt2).Range.End
'change range to string for testing
Myrange2.Select
Mydata2 = Wdapp.Selection.Text

'if blank para then "Chunk" complete
If Len(Mydata2) = 1 Then
'if doc header present ie doc doesn't start with chunk
If Cnt = 1 And Cnt2 = 2 Then
StrCnt = 1
End If
'add spacing FOLLOWING chunk
For Cnt3 = 1 To Spacing
.typeparagraph
Next Cnt3

'reset last re. adding spacing
Wdapp.ActiveDocument.Select
Last = Wdapp.Selection.Paragraphs.Count

'set size of "chunk" to include spacing...
'..(ie. cnt to cnt2 - 1 + spacing = chunk range)
Set Myrange2 = Wdapp.ActiveDocument.Paragraphs(Cnt).Range
Myrange2.SetRange Start:=Myrange2.Start, _
End:=Wdapp.ActiveDocument.Paragraphs _
(Cnt2 - 1 + Spacing).Range.End
'change chunk range to string
Myrange2.Select
Mydata2 = Wdapp.Selection.Text
'avoid doc start error
If Cnt <> 1 Then
'avoid false neg ie last para in chunk is last line on page
If (StrCnt + 1 + ((Cnt2 - 1 + Spacing) - Cnt)) Mod 46 = 0 Then
'add header and spacing
Set Myrange2 = Wdapp.ActiveDocument.Paragraphs _
((Cnt2 - 1 + Spacing)).Range
Myrange2.Select
.typetext Text:=MakeHeader(Header, StrCnt)
For Cnt3 = 1 To Spacing
.typeparagraph
Next Cnt3
'reset last re. adding spacing & header
Wdapp.ActiveDocument.Select
Last = Wdapp.Selection.Paragraphs.Count

'set header & spacing range
Set Myrange3 = Wdapp.ActiveDocument.Paragraphs _
((Cnt2 - 1 + Spacing)).Range
Myrange3.SetRange Start:=Myrange3.Start, _
End:=Wdapp.ActiveDocument.Paragraphs _
(Cnt2 - 1 + Spacing + Spacing).Range.End
'change header and spacing to string
Myrange3.Select
Mydata3 = Wdapp.Selection.Text
'add chunk to bigstring
Bigstring = Bigstring + Mydata2
'add header to bigstring
Bigstring = Bigstring + Mydata3
'change strcnt for addition of chunk
StrCnt = StrCnt + ((Cnt2 - 1 + Spacing) - Cnt) + 1
'change doc cnt past chunk addition ie. before header
Cnt = Cnt + ((Cnt2 - 1 + Spacing) - Cnt) + 1

'change strcnt for addtion of header and spacing
StrCnt = StrCnt + ((Cnt2 - 1 + Spacing + Spacing) _
- (Cnt2 - 1 + Spacing)) + 1
GoTo ReLoop
End If

'check to see IF chunk addition would cross...
'..end of page IN bigstring for chunk range:...
'..next para (strcnt +1) to next para add chunk
For Cnt4 = StrCnt + 1 To (StrCnt + 1 + _
((Cnt2 - 1 + Spacing) - Cnt)) - 1
'if strcnt/46=0 then end of page for chunk in bigstring
If Cnt4 Mod 46 = 0 Then

'check for false pos re. chunk spacing across page
CheckA = False
CheckB = False
For Cnt5 = Cnt4 To (StrCnt + 1 + ((Cnt2 - 1 + Spacing) - Cnt))
If Cnt5 > (StrCnt + 1 + ((Cnt2 - 1 + Spacing) - Cnt)) _
- Spacing Then
If Cnt5 Mod 46 = 0 Then
CheckA = True
End If
If Cnt5 Mod 46 = 1 Then
CheckB = True
End If
If CheckA And CheckB Then
'add chunk to bigstring ie false pos
Bigstring = Bigstring + Mydata2
'remove blank lines ie remove asc char for para
Bigstring = Left(Bigstring, Len(Bigstring) - 1)
'change strcnt for removal of para
StrCnt = StrCnt - 1
Exit For
End If
End If
Next Cnt5
'last para of chunk with content is on last line of page
If Not CheckA And CheckB Then
Set Myrange2 = Wdapp.ActiveDocument.Paragraphs(Cnt).Range
Myrange2.SetRange Start:=Myrange2.Start, _
End:=Wdapp.ActiveDocument.Paragraphs(Cnt2 - 1).Range.End
'change chunk range to string
Myrange2.Select
Mydata2 = Wdapp.Selection.Text
'add header and spacing
Set Myrange2 = Wdapp.ActiveDocument.Paragraphs _
((Cnt2 - 1)).Range
Myrange2.Select
.typetext Text:=MakeHeader(Header, StrCnt)
For Cnt3 = 1 To Spacing
.typeparagraph
Next Cnt3
'reset last re. adding spacing & header
Wdapp.ActiveDocument.Select
Last = Wdapp.Selection.Paragraphs.Count

'set range for header and spacing
Set Myrange3 = Wdapp.ActiveDocument.Paragraphs _
((Cnt2 - 1)).Range
Myrange3.SetRange Start:=Myrange3.Start, _
End:=Wdapp.ActiveDocument.Paragraphs _
(Cnt2 - 1 + Spacing).Range.End
'change header and spacing to string
Myrange3.Select
Mydata3 = Wdapp.Selection.Text
'add chunk to bigstring
Bigstring = Bigstring + Mydata2
'add header to bigstring
Bigstring = Bigstring + Mydata3
'change strcnt for addition of chunk
StrCnt = StrCnt + ((Cnt2 - 1) - Cnt) + 1
'change doc cnt past chunk addition ie. before header..
Cnt = Cnt + ((Cnt2 - 1) - Cnt) + 1

'change strcnt for addtion of header and spacing
StrCnt = StrCnt + ((Cnt2 - 1 + Spacing) - (Cnt2 - 1)) + 1
GoTo ReLoop
End If 'insert header and spacing if false pos

'insert header and spacing if false pos...
'..ie spacing across end of page
If CheckA And CheckB Then
'add header and spacing
Set Myrange2 = Wdapp.ActiveDocument.Paragraphs _
((Cnt2 - 1 + Spacing)).Range
Myrange2.Select
.typetext Text:=MakeHeader(Header, StrCnt)
For Cnt3 = 1 To Spacing
.typeparagraph
Next Cnt3
'reset last re. adding spacing & header
Wdapp.ActiveDocument.Select
Last = Wdapp.Selection.Paragraphs.Count

'set header and spacing range
Set Myrange3 = Wdapp.ActiveDocument.Paragraphs _
((Cnt2 - 1 + Spacing)).Range
Myrange3.SetRange Start:=Myrange3.Start, _
End:=Wdapp.ActiveDocument.Paragraphs _
(Cnt2 - 1 + Spacing + Spacing).Range.End
'change header and spacing to string
Myrange3.Select
Mydata3 = Wdapp.Selection.Text
'add header and spacing to bigstring
Bigstring = Bigstring + Mydata3
'change strcnt for addition of chunk
StrCnt = StrCnt + ((Cnt2 - 1 + Spacing) - Cnt) + 1
'change doc cnt past chunk addition ie. before header
Cnt = Cnt + ((Cnt2 - 1 + Spacing) - Cnt) + 1

'change strcnt for addtion of header and spacing
StrCnt = StrCnt + ((Cnt2 - 1 + Spacing + Spacing) _
- (Cnt2 - 1 + Spacing)) + 1
GoTo ReLoop
End If 'insert header and spacing if false pos
'real positive ie chunk content crosses end of page
'add blank paras to bigstring to move chunk "down"...
'..until header para location found in bigstring
For Cnt6 = StrCnt + 1 To (StrCnt + 1 + _
((Cnt2 - 1 + Spacing) - Cnt))
'add header and spacing
If Cnt6 Mod 46 = 1 Then
Set Myrange2 = Wdapp.ActiveDocument.Paragraphs _
((Cnt2 - 1 + Spacing)).Range
Myrange2.Select
.typetext Text:=MakeHeader(Header, StrCnt)
For Cnt3 = 1 To Spacing
.typeparagraph
Next Cnt3
'reset last re. adding spacing & header
Wdapp.ActiveDocument.Select
Last = Wdapp.Selection.Paragraphs.Count

'set range for header and spacing
Set Myrange3 = Wdapp.ActiveDocument.Paragraphs _
((Cnt2 - 1 + Spacing)).Range
Myrange3.SetRange Start:=Myrange3.Start, _
End:=Wdapp.ActiveDocument.Paragraphs _
(Cnt2 - 1 + Spacing + Spacing).Range.End
'change header and spacing to string
Myrange3.Select
Mydata3 = Wdapp.Selection.Text
'add header to bigstring
Bigstring = Bigstring + Mydata3
'add chunk to big string
Bigstring = Bigstring + Mydata2
'change strcnt for addition of chunk
StrCnt = StrCnt + ((Cnt2 - 1 + Spacing) - Cnt) + 1
'change doc cnt past chunk addition ie. before header
Cnt = Cnt + ((Cnt2 - 1 + Spacing) - Cnt) + 1

'change strcnt for addtion of header and spacing
StrCnt = StrCnt + ((Cnt2 - 1 + Spacing + Spacing) _
- (Cnt2 - 1 + Spacing)) + 1
GoTo ReLoop
Else 'add blank paras to move chunk down in bigstring
'add blank para to string & increase strcnt
Bigstring = Bigstring + Chr(13)
StrCnt = StrCnt + 1
End If 'add blank paras to move chunk down in bigstring
Next Cnt6
End If 'if end of page for chunk IN bigstring
Next Cnt4

Else 'avoid doc start error
'add doc header and spacing to bigstring cnt
StrCnt = StrCnt + Spacing
End If 'avoid doc start error


'*chunk does Not cross end of page
'add chunk to string
Bigstring = Bigstring + Mydata2
If Cnt <> 1 Then
'change strcnt for addition of chunk
StrCnt = StrCnt + ((Cnt2 - 1 + Spacing) - Cnt) + 1
End If
'change doc cnt for addtion of chunk
Cnt = Cnt + ((Cnt2 - 1 + Spacing) - Cnt) + 1
Exit For
End If 'if blank para then "Chunk" complete
Next Cnt2

Else 'move to next doc para re. blank para in doc
Cnt = Cnt + 1
End If 'move to next doc para re. blank para in doc
Loop
'*make output doc
'clear doc contents and replace with string
With Wdapp.ActiveDocument
.Range(0, .Characters.Count).Delete
.content.insertafter Bigstring
End With

End With

'**show doc for testing only
Wdapp.Visible = True
'save doc changes
'**commented for testing only
'Wdapp.activedocument.Close savechanges:=True
'Wdapp.Quit
Set Wdapp = Nothing
Exit Function
ErFix:
On Error GoTo 0
MsgBox "File error"
Wdapp.Quit
Set Wdapp = Nothing
Exit Function
ErFix2:
On Error GoTo 0
MsgBox "Format error"
Wdapp.Quit
Set Wdapp = Nothing
End Function

Function MakeHeader(Hdr As String, StringCnt As Integer) As String
'returns header string with page numbering
'Hdr= header from f(x)
'stringcnt = strcnt from f(x)
Dim PageCnt As Integer, PageStr As String
PageCnt = Round(StringCnt / 46) + 1
PageStr = PageCnt
MakeHeader = Hdr & _
" Page " _
& PageStr
End Function


To use...

Public Sub TestFx()
Dim Temp As Integer
Temp = Application.InputBox("Enter Spacing")
Call PrePrint("No Header Yet", Temp)
End Sub

[fumei]

Well, I have to admire your persistence, or perhaps stubbornness.

Yes, it is a lengthy resources sucking solution, but if that is Ok with you, then that is Ok with you.

I certainly would not recommend it to others. I suggested a number of ways you could make it easier, and cleaner, and more efficient. You chose to basically ignore all of them. You do not, it seemed, try ANYTHING I suggested.

This is clunky wasteful code.

I will mark this thread as solved but if anyone has a simpler solution I would very much appreciate your posting.What an interesting statement.

I DID offer a simpler solution. There IS a simpler solution. You appear to have zero interest is trying to use it.

[fumei]

Appendum: Dave has PM'd me - very politely I must say - to state that I am being a bit unfair here. While I can not in all honesty retract my opinion, I acknowledge my tone is not the best, for which I apologize.

The thread is marked as Solved, but I have offered to continue communicating directly with Dave on this. I remain certain that there can be far better processing. I am positive that it can be done far more efficiently. I have offered to personally take this on as a project.

I hope that Dave and I can work out a solution that works for his needs, and that also satisfies my desire for well written code. When we get there - hopefully - it will be posted as RESolved.

[Dave]

RESolved it is. With Gerry's kind and patient assistance, we've come up with the following code which provides a far superior end product compared to the previous "clunker code" I posted. Quite a bit quicker to I believe. Along the way, I did have an opportunity to learn a bit about styles and their utility (the MS online tutorial wasn't too hard to follow). Firstly, any named style has to be added to the doc manually via the format menu button access in order to later use it with XL VBA (or perhaps they can be added by code?) The type of style applied to any paragraph can be viewed by selecting content within the paragraph and viewing the selection in the styles window (MS2003). To address all of my needs, I required the ability to assign styles based on finding a keyword in either the 1st or last paragraph of the previously defined "chunk" of paragraphs. I will post both solutions which can be trialled using Gerry's "testsummary_Gerry2.doc" (previously posted) which contains the syles referred to in the code. A big bouquet and thank you to Gerry for his much appreciated assistance. Dave

To test..

Public Sub Test()
Dim FLname As String, Tstr As String, Lstr As String
Dim HdrStr As String, Fstr As String
FLname = "C:\testsummary_Gerry2.doc"
Tstr = "Summary"
Fstr = "ProductYr"
Lstr = "Gross"
HdrStr = "No header text yet"
'use for keyword in 1st para
'Call NoPageOverlap2(FLname, Tstr, Fstr, HdrStr)
'use for keyword in last para
Call NoPageOverlap(FLname, Tstr, Lstr, HdrStr)
End Sub


For keyword in last paragraph (XL module code)...

Option Explicit
Public WordApp As Object, Tstr As String
Public Lstr As String, Hstr As String
Sub NoPageOverlap(Fname As String, Title As String, _
Lastword As String, HDR As String)
'title= unique word from title
'lastword= unique word from last para in chunk
'HDR= header text to be added to top of page
Dim oPara As Object
'file error
On Error GoTo ErFix
'open file
Set WordApp = CreateObject("Word.Application")
WordApp.documents.Open Filename:=Fname
'check each para
For Each oPara In WordApp.activedocument.paragraphs

'if not blank para, find "Title" in para
If oPara.Range.Text <> Chr(13) Then
'oPara.Range.Select
With oPara.Range.Find
.Text = Title
.Forward = True
.Execute
'if found apply style "MyTitle"
If .found = True Then
oPara.Style = "MyTitle"
GoTo Below
End If
End With

'if not blank para, find "Lastword" in para
With oPara.Range.Find
.Text = Lastword
.Forward = True
.Execute
'if found apply style "KeepItTogether2"
If .found = True Then
oPara.Style = "KeepItTogether2"
GoTo Below
End If
End With

'if still not found apply "KeepItTogether" style
oPara.Style = "KeepItTogether"

Else
'blank para
oPara.Range.Delete
End If
Below:
Next
'insert headers
Call DoHeaders(HDR)
Exit Sub
ErFix:
On Error GoTo 0
MsgBox "File error"
WordApp.Quit
Set WordApp = Nothing
End Sub
Sub DoHeaders(HDR As String)
Dim oHF As Object
Dim rHeader As Object
WordApp.activedocument.Sections(1).PageSetup. _
DifferentFirstPageHeaderFooter = True
Set oHF = WordApp.activedocument.Sections(1).Headers(1)
With oHF
.LinkToPrevious = False
Set rHeader = oHF.Range
With rHeader
.Text = HDR & vbTab & vbTab & _
"Page "
.collapse Direction:=0
.Fields.Add Range:=rHeader, Type:=33
End With
End With
Set rHeader = Nothing
Set oHF = Nothing
'set print preview for headers
WordApp.activedocument.ActiveWindow.View.Type = 3
WordApp.activedocument.ActiveWindow.View.Zoom.Percentage = 100
'show doc
WordApp.Visible = True
'save doc
'WordApp.activedocument.Close savechanges:=True
'WordApp.Quit
Set WordApp = Nothing
End Sub


For key word in 1st para...

Sub NoPageOverlap2(Fname As String, Title As String, _
Firstword As String, HDR As String)
'title= unique word from title
'firstword= unique word from first para in chunk
'HDR= header text to be added to top of page
Dim Cnt As Integer, Cnt2 As Integer, Temp As Integer
Dim Last As Integer
'file error
On Error GoTo ErFix
'open file
Set WordApp = CreateObject("Word.Application")
WordApp.documents.Open Filename:=Fname
Cnt = 1
Last = WordApp.activedocument.paragraphs.Count
'check each para
Do While Cnt < Last
'if not blank para, find "Title" in para
If WordApp.activedocument.paragraphs(Cnt).Range.Text <> Chr(13) Then
With WordApp.activedocument.paragraphs(Cnt).Range.Find
.Text = Title
.Forward = True
.Execute
'if found apply style "MyTitle"
If .found = True Then
WordApp.activedocument.paragraphs(Cnt).Style = "MyTitle"
Cnt = Cnt + 1
GoTo Below
End If
End With

'if not blank para, find "firstword" in para
With WordApp.activedocument.paragraphs(Cnt).Range.Find
.Text = Firstword
.Forward = True
.Execute
'if found apply style "KeepItTogether"..
'..to all paras in chunk except last para
If .found = True Then
Temp = Cnt
'Temp + 3 is # of paras in chunk less 1
For Cnt2 = Temp To Temp + 3
WordApp.activedocument.paragraphs(Cnt2).Style = "KeepItTogether"
Cnt = Cnt + 1
Next Cnt2

'apply style "KeepItTogether2" to last para in chunk
WordApp.activedocument.paragraphs(Cnt).Style = "KeepItTogether2"
Cnt = Cnt + 1
GoTo Below
End If
End With

'if still not found apply "KeepItTogether" style
WordApp.activedocument.paragraphs(Cnt).Style = "KeepItTogether"
Cnt = Cnt + 1

Else
'blank para. Adjust last for para removal
WordApp.activedocument.paragraphs(Cnt).Range.Delete
Last = Last - 1
End If
Below:
Loop
'insert headers
Call DoHeaders(HDR)
Exit Sub
ErFix:
On Error GoTo 0
MsgBox "File error"
WordApp.Quit
Set WordApp = Nothing
End Sub

[fumei]

Mmmmmmmmmmmmm......styles.

[fumei]

OK. I am not seeing why you have the two procedures, one with Firstword, and one with Lastword. I also fail to see why you are still doing any counting.

This is a logic issue, pure and simple.

In your NoPageOverlap2, you no longer use a paragraph object, and are back to using' check each para
Do While Cnt < Last

Again...you do not need to do this.

You have this code: Cnt = 1
Last = WordApp.activedocument.paragraphs.Count
'check each para
Do While Cnt < Last
'if not blank para, find "Title" in para
If WordApp.activedocument.paragraphs(Cnt).Range.Text <> Chr(13) Then
With WordApp.activedocument.paragraphs(Cnt).Range.Find
.Text = Title
.Forward = True
.Execute
'if found apply style "MyTitle"
If .found = True Then
WordApp.activedocument.paragraphs(Cnt).Style = "MyTitle"
Cnt = Cnt + 1
Goto Below
End If
End With This check to see if the paragraph (but by counting again!) is empty - Chr(13), then checks to see if the range.text contains "Title".

I hate the counting, but will ignore that for now. It checks for "Title", if it does, it makes the style "MyTitle". Fine.

But then you increment the counter to continue processing! You do nothave to stop there, use an Else!
For Each oPara In WordApp.activedocument.paragraphs

'if not blank para
If oPara.Range.Text <> Chr(13) Then
With oPara.Range.Find
‘ check for Title
.Text = Title
.Forward = True
.Execute
If .found = True Then
' apply style "MyTitle"
oPara.Style = "MyTitle"
Else
' Title NOT found, and it is NOT empty
' it either HAS Lastword, or it does NOT
With oPara.Range.Find
.Text = Lastword
.Forward = True
.Execute
If .found = True Then
' if it HAS Lastword
' apply style "KeepItTogether2"
oPara.Style = "KeepItTogether2" ‘ last para
Else
' if it has not Lastword
oPara.Style = "KeepItTogether"
End If
End With
End If
End With
Else
oPara.Range.Delete
End If
NextAgain, no counters, no looping. Just each paragraph in sequence, doing all the tests needed for each paragraph. No need to count chunks at all.

Each paragraph is tested like this:

Is it empty?
If NOT empty;
does it have "Title" in it? Yes? Apply Title style. No? do next test.
does it have Lastword in it? Yes? Apply KeepItTogether2 (the style for the last paragraph of any chunk). No? Apply KeepItTogether (the style for all paragraphs NOT empty, and which do NOT contain Lastword).
If IS empty - delete it.

The chunks can be of whatever number of paragraphs you want. They are not in fact counted (by number) as there is no need to count them.

The criteria is:

Empty = delete it.
Has Title" in it = make Title style
Has Lastword in it = KeepItTogether2 style
All other paragraphs = KeepItTogether

Your code does do this, but it does it by counting, by looping back through the paragraphs...yadda yadda.

No need. You have the logic criteria for each paragraph. Just apply it.

So no need for Firstword.

Now if you NEED Firstword for some reason - although currently you do not - then simply add that further logic to the test for each paragraph. The testing is ONE sequential operation on EACH paragraph. Step-by-step.

[Dave]

Gerry I certainly admire your patience with my continued "clunky" code. However, I did mention that I had some other needs. So to apply the same styles I needed to know a keyword in the 1st paragraph (as the last paragraph is all numbers) and extrapolate from there the next 12 paragraphs which include... blank paragraphs. Also, within the same doc to be formated, are chunks without any blanks (read: stupid guy who designed that has to live with it). Hence the same styles wouldn't work and I wasn't clever enough to figure out another combination that would. So back to counting paragraphs/lines, which works quite well, and in my preliminary testing was about .000004 secs slower for the same doc. So I thought I would post how you could just pick a keyword in the 1st paragraph of a "chunk" and use the same styles to achieve the same format as opposed to picking a keyword in the last paragraph of a chunk. I'm having fun with your help and learning lots. Dave

[fumei]

So to apply the same styles I needed to know a keyword in the 1st paragraph (as the last paragraph is all numbers) and extrapolate from there the next 12 paragraphs which include... blank paragraphs. I am not following this.

1. Why do you need to extrapolate the next 12 paragraphs? Why specifically 12? I don't see a counting for 12.

2. What is relevant about the the last paragraph having numbers?

Even if for some reason 12 is significant, I am doubtful that counting is needed.

Please stipulate the logic required.

[Dave]

Gerry 1) "extrapolate from there the next 12 paragraphs" ergo it's actually 13 paragraphs in total . You need to change the following to equal 13 ie. temp + 12. (My newer version not posted just includes this as a f(x) paramerter) This code is set for the 4 paragraph doc posted.

'Temp + 3 is # of paras in chunk less 1
For Cnt2 = Temp To Temp + 3

2) If the last paragraph has only numbers (along with the 3rd,6th, 8th and 10th paragraphs) how to you provide a last line key word to apply the keepittogether2 style indicating the end of a chunk?
Also, as mentioned there are several blank paragraphs within most chunks but some chunks have less blanks (but they do have 13 paragraphs). This is now a sales record doc which has sales entries with 3 paragraphs data, blank para, 4 paras of data, blank para, 4 paras of data as 1 chunk for the most part. However, the error records within the same doc (ie the other chunks) are not the same ... they are 3 paras of data, blank para, followed by 9 paras of data.
3) Gerry if you trial both codes posted for the doc posted you will find that the "clunker" is actually approx. 1/3 faster. I tried every way possible to not use counting until I came to this realization. I also don't see a mode of accomplishing the objective without counting and I'm not sure if it's worth the effort if it's going to be slower. Continued gratitude for your interest and assistance. Dave