I have a program that creates a report in MS Word 2010 from a database.
For each entry in the database it formats the data into a table in the word document.
However the size of the table can vary if one entry has extraordinarily large field (some 'Memo' fields) it can break a table and split it across 2 pages.

I want at the top of each page a common title (I realise this may be better using header/footers), i then want to start adding tables until one is split, if this happens insert a page break, another title and carry on until the end.

I have tried:

        Dim oWord As Word.Application
        Dim oDoc As Word.Document
        Dim oPara1 As Word.Paragraph
        Dim Pos As Double
        Dim oRng As Word.Range
        oWord = CreateObject("Word.Application")
        oWord.Visible = True
        oDoc = oWord.Documents.Add
        oDoc.PageSetup.LeftMargin = oWord.Application.CentimetersToPoints(1.5)
        oDoc.PageSetup.RightMargin = oWord.Application.CentimetersToPoints(1.5)
        oDoc.PageSetup.TopMargin = oWord.Application.CentimetersToPoints(1.5)
        oDoc.PageSetup.BottomMargin = oWord.Application.CentimetersToPoints(1.5)
        oPara1 = oDoc.Content.Paragraphs.Add
        oPara1.Range.Text = "Page Title"
        oPara1.Range.Font.Bold = True
        oPara1.Range.Font.Underline = True
        oPara1.Range.Font.Size = "16"
        oPara1.Range.ParagraphFormat.Alignment = Word.WdParagraphAlignment.wdAlignParagraphCenter
        oPara1.Format.SpaceAfter = 6

        Pos = oWord.CentimetersToPoints(23)
        oDoc.Bookmarks.Item("\endofdoc").Range.InsertParagraphAfter()
        Do
            oRng = oDoc.Bookmarks.Item("\endofdoc").Range
            oRng.ParagraphFormat.SpaceAfter = 6
            Dim oTable As Word.Table
            oTable = oDoc.Tables.Add(oDoc.Bookmarks.Item("\endofdoc").Range, 7, 4)
            oTable.Range.ParagraphFormat.SpaceAfter = 6
            oTable.Range.ParagraphFormat.Alignment = Word.WdParagraphAlignment.wdAlignParagraphLeft

            '----- ADD TABLE DATA -----

            oRng = oDoc.Bookmarks.Item("\endofdoc").Range
            oTable.Rows.AllowBreakAcrossPages = False
            ' oPara1.Format.SpaceAfter = 6
            'oRng.InsertParagraphAfter()
        Loop While Pos >= oRng.Information(Word.WdInformation.wdVerticalPositionRelativeToPage)
        oRng.Collapse(Word.WdCollapseDirection.wdCollapseEnd)
        oRng.InsertBreak(Word.WdBreakType.wdPageBreak)
        oRng.Collapse(Word.WdCollapseDirection.wdCollapseEnd)
        oRng.InsertAfter("Page Title")
        oRng.Font.Bold = True
        oRng.Font.Underline = True
        oRng.Font.Size = "16"
        oRng.ParagraphFormat.Alignment = Word.WdParagraphAlignment.wdAlignParagraphCenter
        oRng.ParagraphFormat.SpaceAfter = 6

The do loop sort of works if the table falls after a set position but they may never do that as the overall table height could vary (although I must point out that I envisage a single table should never get to a position where it is bigger than 1 page!)

Recommended Answers

All 11 Replies

Here is a Word VBA macro that will split a table whenever the page number changes. It appears that you are fluent in Word Interop so it should not be too hard for you make the needed changes to convert it to VB.Net and add your Title Insert code.

Sub SplitTable(t As Word.Table)
    Dim r As Row
    Dim CurPage As Integer
    Dim LastPage As Integer
    t.Rows(1).Select
    LastPage = Selection.Information(wdActiveEndPageNumber)
        For Each r In t.Rows
        r.Select ' Selected it so its the activerange
        CurPage = Selection.Information(wdActiveEndPageNumber)
        If CurPage <> LastPage Then
            t.Split (r.Index)
            r.Select ' Selected it so its the activerange
            Dim NewTable As Table
            Set NewTable = Selection.Tables(1)
            Call SplitTable(NewTable)
            Exit For
        End If
     Next r
End Sub

Thanks for that, I must admit though I am NOT as fluent as my previous post makes out, it is stuff cobbled from code examples on the internet!

I shall have a look and see if I can bodge it in see if it'll work...

commented: Honesty + Effort. So rare around here. I like it!! +7

It should be easy to convert. Just delete the "Set" keywords and adust some namespace references.

I just did not feel like setting up a VB project to test it. I develop this stuff in VBA first because it gives instant results and is easy to prototype and I have yet to find anything that does not easily convert to .Net interop. Although, it can sometimes be a challenge to find what namespace VBA constants are hidden under on the .Net side.

If you have any problems, just ask.

Sorry to be a pain but not being fluent im struggling:

                Dim r As Word.Row
                Dim CurPage As Integer
                Dim LastPage As Integer
                oTable.Rows(1).Select()
                LastPage = Selection.Information(wdActiveEndPageNumber)
                For Each r In oTable.Rows
                    r.Select() ' Selected it so its the activerange
                    CurPage = Selection.Information(wdActiveEndPageNumber)
                    If CurPage <> LastPage Then
                        oTable.Split(r.Index)
                        r.Select() ' Selected it so its the activerange
                        Dim NewTable As Table
                        NewTable = Selection.Tables(1)
                        Call SplitTable(NewTable)
                        Exit For
                    End If
                Next r

Selection.Information(wdActiveEndPageNumber) = wdActiveEndPageNumber not declared error

changing to:

LastPage = Selection.Information(WdInformation.wdActiveEndPageNumber) = Selection.Information reference to non shared member error

Also

NewTable = Selection.Tables(1) = Selection.Information reference to non shared member error

Call SplitTable(NewTable) = not declared error

Rats! I forgot to tell you how to get the active Selection. Oh well, see if this makes any sense to you.

Imports Microsoft.Office.Interop

Public Class Form1
   Private Sub Form1_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load
      PlayWithWord()
   End Sub

   Private Sub PlayWithWord()
      Dim app As New Word.Application
      app.Visible = True
      Dim doc As Word.Document = app.Documents.Open("D:\My Documents\Splittable.docx")
      ' remember that office indices start at 1 not 0
      SplitTable(doc.Tables(1)) 'Split the first table up if it needs splitting
      doc.Close(False)
      doc = Nothing
      app.Quit()
      app = Nothing
      GC.Collect()
   End Sub

   Sub SplitTable(ByVal t As Word.Table)
       Dim r As Word.Row
       Dim CurPage As Integer
       Dim LastPage As Integer
       t.Rows(1).Select() ' remember that office indices start at 1 not 0

       Dim myapp As Word.Application = t.Tables.Application
       LastPage = CInt(myapp.Selection.Information(Word.WdInformation.wdActiveEndPageNumber))

       For Each r In t.Rows
          r.Select() ' Selected it so its the activerange
          CurPage = CInt(myapp.Selection.Information(Word.WdInformation.wdActiveEndPageNumber))
          If CurPage <> LastPage Then
             t.Split(r.Index)
             r.Select() ' Selected it so its the activerange
             Dim NewTable As Word.Table
             NewTable = myapp.Selection.Tables(1)
             Call SplitTable(NewTable)
             Exit For
          End If
       Next r
    End Sub

End Class

I can't seem to get this to work the way I want, I want it to check each table not just the first.

My program creates a document and fills it with, at present 31 tables, then I tried doing a For loop for each table in oDoc.Tables.
I modified the code slightly so it selects the last row of the table first to get the "LastPage" then when it does get to a case where CurPage <> LastPage it tries the t.Split(r.Index) but I get a Bad Parameter error.

Running a for loop on the tables will not work as by splitting then, you are adding to the collection.

In your report generation code, as soon as you are finished populating a table, pass its reference to the split routine. This assumes you are following a start to end generation pattern.

I find that the line at the end of table creation SplitTable(oDoc.Tables(1)) 'Split the first table up if it needs splitting will check the table at the top of the page every time, if i use SplitTable(oDoc.Tables(rec+1)) 'Split the first table up if it needs splitting so it in theory should check the table number i get "The requested member of the collection does not exist."

My entire code for creating the tables:

Dim oWord As Word.Application
    Dim oDoc As Word.Document
    Dim oTable As Word.Table
    Dim oPara1 As Word.Paragraph
    Dim Pos As Double
    Dim oRng As Word.Range

    Public Sub CounterRep()
        oWord = CreateObject("Word.Application")
        oWord.Visible = True
        oDoc = oWord.Documents.Add
        oDoc.PageSetup.LeftMargin = oWord.Application.CentimetersToPoints(1.5)
        oDoc.PageSetup.RightMargin = oWord.Application.CentimetersToPoints(1.5)
        oDoc.PageSetup.TopMargin = oWord.Application.CentimetersToPoints(2)
        oDoc.PageSetup.BottomMargin = oWord.Application.CentimetersToPoints(1.5)

        With oDoc.Sections(1).Headers(Word.WdHeaderFooterIndex.wdHeaderFooterPrimary).Range
            .Font.Bold = True
            .Font.Underline = True
            .Font.Size = "16"
            .Text = "Counter Report"
            .ParagraphFormat.Alignment = Word.WdParagraphAlignment.wdAlignParagraphCenter
        End With

        Dim rec As Integer
        For rec = 0 To sn.Count - 1
            oRng = oDoc.Bookmarks.Item("\endofdoc").Range
            oTable = oDoc.Tables.Add(oDoc.Bookmarks.Item("\endofdoc").Range, 7, 4)
            oTable.Rows.AllowBreakAcrossPages = False
            oTable.Range.ParagraphFormat.SpaceAfter = 6
            oTable.Range.ParagraphFormat.Alignment = Word.WdParagraphAlignment.wdAlignParagraphLeft
            oTable.Range.Font.Size = "11"
            oTable.Range.Font.Underline = False
            oTable.Range.Font.Bold = False

            oTable.Columns(1).Width = oWord.Application.CentimetersToPoints(4.5)
            oTable.Columns(2).Width = oWord.Application.CentimetersToPoints(5)
            oTable.Columns(3).Width = oWord.Application.CentimetersToPoints(3.5)
            oTable.Columns(4).Width = oWord.Application.CentimetersToPoints(5)

            oTable.Cell(1, 1).Range.Text = "Counter Serial Number:"
            oTable.Cell(1, 2).Range.Text = sn(rec)
            oTable.Cell(1, 1).Range.Font.Bold = True
            oTable.Cell(1, 3).Range.Text = "Phone Number:"
            oTable.Cell(1, 4).Range.Text = pn(rec)
            oTable.Cell(1, 3).Range.Font.Bold = True
            oTable.Cell(2, 1).Range.Text = "Manufacturer:"
            oTable.Cell(2, 2).Range.Text = man(rec)
            oTable.Cell(2, 1).Range.Font.Bold = True
            oTable.Cell(2, 3).Range.Text = "Counter Model:"
            oTable.Cell(2, 4).Range.Text = mo(rec)
            oTable.Cell(2, 3).Range.Font.Bold = True
            oTable.Cell(3, 1).Range.Text = "Site Ref:"
            oTable.Cell(3, 2).Range.Text = ref(rec)
            oTable.Cell(3, 1).Range.Font.Bold = True
            oTable.Cell(3, 3).Range.Text = "District:"
            oTable.Cell(3, 4).Range.Text = di(rec)
            oTable.Cell(3, 3).Range.Font.Bold = True
            oTable.Cell(4, 1).Range.Text = "AZ Reference:"
            oTable.Cell(4, 2).Range.Text = az(rec)
            oTable.Cell(4, 1).Range.Font.Bold = True
            oTable.Cell(4, 3).Range.Text = "OSGR"
            oTable.Cell(4, 4).Range.Text = east(rec) & "," & north(rec)
            oTable.Cell(4, 3).Range.Font.Bold = True
            oTable.Cell(5, 1).Range.Text = "Site Description:"
            oTable.Cell(5, 2).Range.Text = desc(rec)
            oTable.Cell(5, 1).Range.Font.Bold = True
            oTable.Cell(6, 1).Range.Text = "Counter Notes:"
            oTable.Cell(6, 2).Range.Text = no(rec)
            oTable.Cell(6, 1).Range.Font.Bold = True
            oTable.Cell(9, 1).Range.Text = "Site Notes:"
            oTable.Cell(9, 2).Range.Text = snote(rec)
            oTable.Cell(9, 1).Range.Font.Bold = True

            oTable.Cell(5, 2).Merge(MergeTo:=oTable.Cell(5, 4))
            oTable.Cell(6, 2).Merge(MergeTo:=oTable.Cell(6, 4))
            oTable.Cell(7, 2).Merge(MergeTo:=oTable.Cell(7, 4))

            oTable.Rows.AllowBreakAcrossPages = False
            oPara1 = oDoc.Content.Paragraphs.Add(oDoc.Bookmarks.Item("\endofdoc").Range)
            oRng = oDoc.Bookmarks.Item("\endofdoc").Range

            SplitTable(oDoc.Tables(rec+1)) 'Split the first table up if it needs splitting 
            If rec = sn.Count - 1 Then Exit For
            rec = rec + 1
        Next
    End Sub

I have some arrays with the values I want in each table, so it does a For loop so i get all the data in the tables.

Am I just being really thick?

Well I, thought that what I left you to figure out was not a trival as I thought. The darn thing looses the row reference when adding a formated paragraph for you Title. It took a bit of experimenting, but I think if you follow the pattern shown below it should work for you. At least the test case worked.

Imports Microsoft.Office.Interop

Public Class Form1
   Private Sub Form1_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load
      PlayWithWord()
   End Sub

   Private Sub PlayWithWord()
      Dim app As New Word.Application
      app.Visible = True

      Dim doc As Word.Document = app.Documents.Add 'app.Documents.Open("D:\My Documents\Splittable.docx")
      Dim view As Word.View = app.ActiveWindow.View
      With view.Zoom
        .PageColumns = 2
        .PageRows = 1
      End With
      view = Nothing
      Dim table As Word.Table

      doc.Bookmarks.Item("\endofdoc").Select()
      app.Selection.Text = "Flintstones. Meet the Flintstones. They're the modern stone age family.  From the town of Bedrock, They're a page right out of history."

      doc.Bookmarks.Item("\endofdoc").Select()
      table = doc.Tables.Add(app.Selection.Range, 70, 1)
      Stop
      Dim Title As String = "Top of Page Title"

      SplitTable(table, Title)

      Stop

      doc.Bookmarks.Item("\endofdoc").Select()
      app.Selection.Text = "fred was here" & vbNewLine
      Stop

      doc.Bookmarks.Item("\endofdoc").Select()
      app.Selection.Range.Select()
      Stop

      table = doc.Tables.Add(app.Selection.Range, 50, 1)
      Stop
      SplitTable(table, Title)
      Stop

      doc.Bookmarks.Item("\endofdoc").Select()
      app.Selection.Text = "end of doc"

      Stop

      doc.Close(False)
      doc = Nothing
      app.Quit()
      app = Nothing
      GC.Collect()
   End Sub

   Sub SplitTable(ByVal t As Word.Table, ByVal Title As String)
       Dim r As Word.Row
       Dim CurPage As Integer
       Dim LastPage As Integer
       Const wdCharacter As Int32 = 1

       t.Rows(1).Select() ' remember that office indices start at 1 not 0

       Dim myapp As Word.Application = t.Tables.Application
       LastPage = CInt(myapp.Selection.Information(Word.WdInformation.wdActiveEndPageNumber))

       For Each r In t.Rows
          r.Select() ' Selected it so its the activerange
          CurPage = CInt(myapp.Selection.Information(Word.WdInformation.wdActiveEndPageNumber))
          If CurPage <> LastPage Then

             t.Split(r.Index)

             ' unfortunately the row reference is destroyed by adding a paragraph
             ' so will need to get the new table refernce first then move back out of the table

             r.Select() ' Selected it so its the activerange
             Dim NewTable As Word.Table
             NewTable = myapp.Selection.Tables(1)
             myapp.Selection.MoveLeft(wdCharacter, 2)

             ' wrap the Title with a PageBreakBefore format
             ' to prevent it from jumping to the previous page
             Dim para As Word.Paragraph = myapp.Selection.Paragraphs.Add(myapp.Selection.Range)
             para.Format.PageBreakBefore = -1
             para.Format.SpaceAfter = 0
             myapp.Selection.Range.Text = Title

             Call SplitTable(NewTable, Title)
             Exit For
          End If
       Next r
    End Sub

End Class

Thanks for all the help, but i'm beginning to think I've bitten off more than I can chew, something that seemed so simple is proving to be a bit of a headache.
I can't get it to work for my particular example.
Your code above works but I can't get it to work how I want it to for my example.
Below is my Code condensed down to just creating the tables without data, it creates 4 tables on page on, on the 5th the last row jumps to page 2, the splitting splits off the last row onto the new page, rather than moving the whole of the 5th table to the top of the second page.

 Public Sub CounterRep()
        oWord = CreateObject("Word.Application")
        oWord.Visible = True

        oDoc = oWord.Documents.Add
        Dim view As Word.View = oWord.ActiveWindow.View
        With view.Zoom
            .PageColumns = 2
            .PageRows = 1
        End With
        view = Nothing
        oDoc.PageSetup.LeftMargin = oWord.Application.CentimetersToPoints(1.5)
        oDoc.PageSetup.RightMargin = oWord.Application.CentimetersToPoints(1.5)
        oDoc.PageSetup.TopMargin = oWord.Application.CentimetersToPoints(2)
        oDoc.PageSetup.BottomMargin = oWord.Application.CentimetersToPoints(1.5)

        With oDoc.Sections(1).Headers(Word.WdHeaderFooterIndex.wdHeaderFooterPrimary).Range
            .Font.Bold = True
            .Font.Underline = True
            .Font.Size = "16"
            .Text = "Counter Report"
            .ParagraphFormat.Alignment = Word.WdParagraphAlignment.wdAlignParagraphCenter
        End With

        'Keep inserting text. When you get to 7 inches from top of the
        'document, insert a hard page break.
        Dim rec As Integer
        For rec = 0 To sn.Count - 1
            oDoc.Bookmarks.Item("\endofdoc").Select()
            oTable = oDoc.Tables.Add(oWord.Selection.Range, 7, 4)
            oTable.Rows.AllowBreakAcrossPages = False
            oTable.Range.ParagraphFormat.SpaceAfter = 6
            oTable.Range.ParagraphFormat.Alignment = Word.WdParagraphAlignment.wdAlignParagraphLeft
            oTable.Range.Font.Size = "11"
            oTable.Range.Font.Underline = False
            oTable.Range.Font.Bold = False

            oTable.Columns(1).Width = oWord.Application.CentimetersToPoints(4.5)
            oTable.Columns(2).Width = oWord.Application.CentimetersToPoints(5)
            oTable.Columns(3).Width = oWord.Application.CentimetersToPoints(3.5)
            oTable.Columns(4).Width = oWord.Application.CentimetersToPoints(5)

            oPara1 = oDoc.Content.Paragraphs.Add(oDoc.Bookmarks.Item("\endofdoc").Range)
            SplitTable(oTable)
            If rec = sn.Count - 1 Then Exit For
            rec = rec + 1
        Next
End Sub

Sub SplitTable(ByVal t As Word.Table)
        Dim r As Word.Row
        Dim CurPage As Integer
        Dim LastPage As Integer
        Const wdCharacter As Int32 = 1
        t.Rows(1).Select() ' remember that office indices start at 1 not 0
        Dim myapp As Word.Application = t.Tables.Application
        LastPage = CInt(myapp.Selection.Information(Word.WdInformation.wdActiveEndPageNumber))
        't.Rows(1).Select() ' remember that office indices start at 1 not 0
        ' myapp  = t.Tables.Application
        For Each r In t.Rows
            r.Select() ' Selected it so its the activerange
            CurPage = CInt(myapp.Selection.Information(Word.WdInformation.wdActiveEndPageNumber))
            If CurPage <> LastPage Then
                t.Split(r.Index)
                ' unfortunately the row reference is destroyed by adding a paragraph
                ' so will need to get the new table refernce first then move back out of the table
                r.Select() ' Selected it so its the activerange
                Dim NewTable As Word.Table
                NewTable = myapp.Selection.Tables(1)
                myapp.Selection.MoveLeft(wdCharacter, 2)
                ' wrap the Title with a PageBreakBefore format
                ' to prevent it from jumping to the previous page
                Dim para As Word.Paragraph = myapp.Selection.Paragraphs.Add(myapp.Selection.Range)
                para.Format.PageBreakBefore = -1
                para.Format.SpaceAfter = 0
                'myapp.Selection.Range.Text = Title
                Call SplitTable(NewTable)
                Exit For
            End If
        Next r
    End Sub

I removed/commented out the "Title" references as I don't require one at the moment.

I think I have realised with the above I'm trying to split a table, rather than PREVENT a table from splitting or at least if it does split across pages move the whole table...

I thinkI've got it do what I wanted... (I think!)

        Dim CurPage As Integer
        Dim LastPage As Integer
        t.Rows(7).Select() ' remember that office indices start at 1 not 0
        Dim myapp As Word.Application = t.Tables.Application
        LastPage = CInt(myapp.Selection.Information(Word.WdInformation.wdActiveEndPageNumber))
        t.Rows(1).Select() ' remember that office indices start at 1 not 0
        myapp = t.Tables.Application
        CurPage = CInt(myapp.Selection.Information(Word.WdInformation.wdActiveEndPageNumber))
        If CurPage <> LastPage Then
            myapp.Selection.InsertBreak()
        End If

So if first and last rows of table are on different pages then page break at the beginning!
All goes to pot if 1 table is bigger than 1 complete page, but I don't envisage that happening! (I hope!)

Be a part of the DaniWeb community

We're a friendly, industry-focused community of developers, IT pros, digital marketers, and technology enthusiasts meeting, networking, learning, and sharing knowledge.