Formatting macro to set the number of words per page

[jbest]

Hi,

I need help with writing a macro. I'm new at this and have been researching a lot on the internet but can't seem to find anything that works. Can anyone help? What i need to do is create something that will restrict the number of words per page to 270 to 310 and remove SmartArt I have on the first page.

For the words, the first page has some introductory text, the SmartArt graphic that doesn't contain the introductory text, and then after that a series of paragraphs with the List Number 4 style above each. Again I want to restrict the number of words to 270 and 310 per page with the macro making sure not to split any of the paragraphs with the List Number 4 style above them. The document itself is single spaced. Is this possible?

Here's an example of how the document looks:

Introductory text.... (~50 - 200 words usually)

SmartArt graphic

1.
Paragraph Text

2.
Paragraph Text

3.
Paragraph Text

[gmayor]

Without access to the document, it is difficult to be sure that a process will give the intended results, but based upon your comments the following might work for you. The major issues are what the application considers is a 'word' compared with your expectation, and what to do if the break would fall outside your range of words, because of the word counts of the paragraphs around the break point. The macro counts 270 'Words' then moves to the end of the next unnumbered paragraph. If the count is less than 310 a page break is inserted. If the count is greater than 310 the end of the section is moved back to the end of the previous unnumbered paragraph and the break inserted there instead. Problem is that this might mean less than 270 Words.


Sub AddPageBreak()
Dim oPage As Range
Dim orng As Range
Dim oshape As InlineShape
Selection.HomeKey wdStory
Set oPage = ActiveDocument.Bookmarks("\page").Range
For Each oshape In oPage.InlineShapes
Set orng = oshape.Range
orng.End = orng.End + 1
orng.Delete
Exit For
Next oshape
Set orng = ActiveDocument.Range(0, 0)
orng.MoveEnd wdWord, 270
If orng.Characters.Last.Style = "List Number 4" Then
orng.MoveEnd wdParagraph
End If
orng.MoveEndUntil Chr(13)
If orng.Words.Count > 310 Then
orng.MoveEnd wdParagraph, -2
End If
orng.Collapse 0
orng.InsertBreak wdSectionBreakNextPage
lbl_Exit:
Exit Sub
End Sub

[jbest]

Thank you Graham Mayor, I appreciate your help

[gmaxey]

You say that you have a series of paragraphs with List Number 4 style above each. What is the style applied to the text itself?

What would you want to happen in a case where a paragraph contains enough text so both the lower limit 270 and upper limit 310 word count is contained within that paragraph? If it is moved to the next page then word count of the current page would be less than 270.

[jbest]

Hi Greg, thank you for responding.

The style is Normal for the paragraph text. I see the problem of what you're saying. After some thought, I realized it would be OK if the document averaged 290 words per page still without the split in paragraphs. Is that possible? Sorry for not saying this sooner.

[gmayor]

Unless you know how many words are in the paragraphs, or you are prepared to accept a break within a paragraph, it doesn't matter how many words you specify, as the core problem remains the same as I explained earlier, and was reinforced by Greg.

[jbest]

Hi Graham, thank you again for your response. I will accept the breaks in paragraphs if I could average 290 words per page.

[gmaxey]

This is really no end of hairball. However, the following while not as fast will (I think) provide a truer word count:


Sub AddPageBreak()
Dim oPar As Paragraph
Dim oPage As Range, oBrkRng As Range, oFirstRng As Range, oLastRng As Range
Dim oILS As InlineShape
Dim lngIndex As Long, lngOffset As Long
For Each oPar In ActiveDocument.Paragraphs
If oPar.Style = "List Number 4" Then
If oPar.Next.Style = "Normal" Then
oPar.KeepWithNext = True
End If
End If
Next

Selection.HomeKey wdStory
Set oPage = ActiveDocument.Bookmarks("\page").Range
oPage.InlineShapes(1).Delete
Do
oPage.Collapse wdCollapseStart
lngOffset = 0
lngIndex = 0
Do Until oPage.ComputeStatistics(wdStatisticWords) = 290 + lngOffset
Debug.Print oPage.ComputeStatistics(wdStatisticWords)
oPage.MoveEnd wdWord, 1
If oPage.End = ActiveDocument.Range.End Then Exit Sub
lngOffset = oPage.ListParagraphs.Count
If lngIndex <> lngOffset Then
oPage.MoveEnd wdWord, 1
lngIndex = lngIndex + 1
End If
Loop
Select Case oPage.Paragraphs.Last.Style
Case "List Number 4"
'Then add page break before
Set oBrkRng = oPage.Paragraphs.Last.Range
oPage.Collapse wdCollapseEnd
oPage.Select
With oBrkRng
.Collapse wdCollapseStart
.InsertBreak wdPageBreak
End With
Case "Normal"
Set oFirstRng = oPage.Paragraphs.Last.Range
Set oLastRng = oPage.Paragraphs.Last.Range
oFirstRng.End = oPage.End
oLastRng.Start = oPage.End
Select Case True
Case oFirstRng.ComputeStatistics(wdStatisticWords) < 20
'Page Break before previous List Number paragraph
Set oBrkRng = oPage.Paragraphs.Last.Previous.Range
With oBrkRng
.Collapse wdCollapseStart
.InsertBreak wdPageBreak
End With
Case oLastRng.ComputeStatistics(wdStatisticWords) < 20
'Page Break before next List Number paragraph
Set oBrkRng = oPage.Paragraphs.Last.Next.Range
With oBrkRng
.Collapse wdCollapseStart
.InsertBreak wdPageBreak
End With
Case Else
oPage.Select
oFirstRng.Collapse wdCollapseEnd
oFirstRng.Select
Set oBrkRng = Selection.Bookmarks("\line").Range
With oBrkRng
.Collapse wdCollapseEnd
.InsertBreak wdPageBreak
End With
End Select
oLastRng.Collapse wdCollapseEnd
oLastRng.Select
End Select

Set oPage = Selection.Bookmarks("\page").Range
Loop Until oPage.End = ActiveDocument.Range.End
lbl_Exit:
Exit Sub
End Sub

[jbest]

Thank you Greg! The macro seems to be working however it doesn't stop once it reaches the end of the document.