Consulting

Results 1 to 7 of 7

Thread: Excel to Word. Move Position of Page Break

  1. #1

    Excel to Word. Move Position of Page Break

    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

  2. #2
    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

  3. #3
    I showed you how to do this in your earlier post http://www.vbaexpress.com/forum/show...he-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
    Graham Mayor - MS MVP (Word) 2002-2019
    Visit my web site for more programming tips and ready made processes
    http://www.gmayor.com

  4. #4
    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.

  5. #5
    Knowledge Base Approver VBAX Wizard
    Joined
    Apr 2012
    Posts
    5,635
    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

  6. #6
    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

  7. #7
    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

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •