Excel to Word. Move Position of Page Break

[metalwork10]

Hi All,
My test routine below works but needs 2 items adjusting.
1) The page break is inserted on a new line which creates a blank page (page 2 in the document). I would like to insert the page break on the same line as the text "Keep with test 11" this will result in removing the second blank page
2) How to remove the paragraph marks at the end of the document

Any help will greatly help. Many thanks in advance


Sub TextToWord()

Dim lCount As Long 'generic counter
Dim lPageCount As Long 'current document page number
Dim sText As String 'generic text
Dim lWdPageNumber As Long 'document page number after inserting text
Dim oRngBreak As Object 'Range object for page break


On Error Resume Next
Set oApp = GetObject(, "Word.Application")
If Err Then
Set oApp = CreateObject("Word.Application")
End If
On Error GoTo 0




Set oDoc = oApp.Documents.Add
Set oSelection = oApp.Selection

'uncomment to view document while running code
'oApp.Visible = True

For lCount = 1 To 23
sText = "Text to test" & lCount & vbNewLine & "Keep with test " & lCount & vbNewLine & vbNewLine


'get current page number before inserting text
lPageCount = oSelection.Information(3) '(3=wdActiveEndPageNumber)


'send text to word document
With oSelection
.ParagraphFormat.Alignment = 0 '(0=left align text)
.Font.Name = "Times New Roman"
.Font.Size = 11
.Font.Color = 0
.Font.Bold = False
.TypeText (sText)
End With


'word document page number after inserting text
lWdPageNumber = oSelection.Information(3)


'insert page break on previous page if text over wraps to another page
'this has the effect of inserting the previous text on a new page
If lWdPageNumber > lPageCount Then
Set oRngBreak = oSelection.Paragraphs(1).Range.Previous.Paragraphs(1).Range
oRngBreak.Collapse Direction:=(1) '(1= wdCollapseStart)
oRngBreak.InsertBreak (7)


'select position in document
oSelection.Paragraphs(1).Range.Previous.Paragraphs(1).Range.Select
oSelection.Collapse Direction:=(1) 'wdCollapseEnd


'have different text at the top of a new page
sText = "Top of page " & lWdPageNumber & vbNewLine & vbNewLine




'send text to top of page in word document
With oSelection
.ParagraphFormat.Alignment = 1 'center text
.Font.Name = "Times New Roman"
.Font.Size = 14
.Font.Color = 255
.Font.Bold = True
.TypeText (sText)
End With
End If


Next lCount


'add text at end of the document
sText = "This is the end of the document"
With oSelection
.ParagraphFormat.Alignment = 0 'left align text
.Font.Name = "Times New Roman"
.Font.Size = 14
.Font.Color = 255 'red
.Font.Bold = True
.TypeText (sText)
End With


oApp.Visible = True


End Sub

[metalwork10]

Sorry I forgot to include the Module variables

Option Explicit

Public oApp As Object 'application
Public oDoc As Object 'document
Public oSelection As Object 'Create a Selection object

[gmayor]

I showed you how to do this in your earlier post http://www.vbaexpress.com/forum/showthread.php?68146-Excel-text-to-Word-Document-controlling-the-Page-Breaks
The problem here is that you have moved the goalposts with an added text string that has three paragraphs, including an empty paragraph and all three determine when there is a break. Using the code I posted with this changed string will result in an empty paragraph at the top of the second page. That is easily removed as are any trailling empty paragraphs on the subsequent page.


Option Explicit
'Graham Mayor - https://www.gmayor.com - Last updated - 16 Dec 2020
Private oApp As Object 'application
Private oDoc As Object 'document
Private oRng As Object, orngBreak As Object 'Range objects


Sub TextToWord()
Dim lCount As Long
Dim lLineNumber As Long
Dim lPageCount As Long
Dim i As Integer
Dim sText As String
Dim lWdPageNumber As Long




On Error Resume Next
Set oApp = GetObject(, "Word.Application")
If Err Then
Set oApp = CreateObject("Word.Application")
End If
On Error GoTo 0


Set oDoc = oApp.Documents.Add
Set oRng = oDoc.Range
For lCount = 1 To 23
sText = "Text to test" & lCount & vbNewLine & "Keep with test " & lCount & vbNewLine & vbNewLine
'get current line number and page number before inserting text
lLineNumber = oRng.Information(10) 'wdFirstCharacterLineNumber
lPageCount = oRng.Information(3) 'wdActiveEndPageNumber
oRng.Collapse 0
oRng.Text = sText
lWdPageNumber = oRng.Information(3)
If lWdPageNumber > lPageCount Then
Set orngBreak = oRng.Paragraphs(1).Range.Previous.Paragraphs(1).Range
orngBreak.Collapse 1
orngBreak.InsertBreak (7)
End If
Next lCount
Set oRng = oDoc.Range
oRng.Collapse 0
oRng.Select
'remove empty first paragraph on page 2
If Len(oDoc.Bookmarks("\page").Range.Paragraphs(1).Range) = 1 Then
oDoc.Bookmarks("\page").Range.Paragraphs(1).Range.Delete
End If
'remove empty paragraphs at end of page 2
oRng.MoveStartWhile Chr(13), -1073741823 'wdBackward
oRng.Text = ""
oApp.Visible = True
End Sub

[metalwork10]

Hi Graham,
Yes you have answered the question I posted (many thanks). I think I didn't post it very well due to my lack of coding knowledge with MS Word
You are working with a Range (which I guess is the best way of doing things). The problem is I have a large routine over several modules which was not possible to post hence I developed a Test file. Working with a Range I found I could not format the text as it was sent to Word. (I guess text should be sent to Word and formatted afterwards)
When my text is sent to Word I am referencing the Selection point in the Document thus allowing me to format the text (probably not the right way to do things). I was hoping to use your example and get it to work within my code but I'm not having any luck so far. I know you probably can't help without seeing the file but any ideas to point me in the right direction will help. Again many thanks for your time.:banghead:

[snb]

Avoid unnecessary variables.
Avoid 'Select', 'Selection' in VBA


Sub M_snb()
With CreateObject("Word.document")
For j = 1 To 60
c00 = c00 & vbCr & "Text to test" & j & "~Keep with test " & j & "~~"
Next
.Content = Replace(c00, "~", vbLf)

y = .Paragraphs.first.Range.Information(3)
For j = 1 To .Paragraphs.Count
If .Paragraphs(j).Range.Information(3) <> y Then
y = .Paragraphs(j).Range.Information(3)
.Paragraphs(j - 1).Range.insertbreak (7)
End If
Next
End With
End Sub

[metalwork10]

snb: Yes great advice. I should know this from coding Excel...Don't select cells and only read and write to the spreadsheet once. For now my code will have to be slower while I get to grips with MS Word:yes

[metalwork10]

Graham: Sorry I moved the goal posts but I now have my routine working as needed thanks to the extra code you provided. To me it was worth the second post...Many thanks for your time:)