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!)
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...
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!)