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.