creating tables in loop

[joy]

I need to create few tables in a loop.
(
while not rec.EOF
'here creating and managing the table
'inserting data , formating the cells and so on
rec.movenext
wend
)
each table should be in a different page , but same
document, and should contain 33 rows and 4 colomns.

I tried thousands of ways, now i cant restore the first
try which gave almost what i need, in the last try i got
an error "object can not ADD table " or something like
that. and i'm helpless
please your help
joy

 

[Peter Hewett]

Hi joy

Someone e;se (or was it you?) wanted to do the same thing. Here's what I posted last
time, I hope it's of help to you:

Public Sub CreateWordTable(ByVal rs As DAO.Recordset, _
ByVal strFilePathAndName As String)

Const RECORDS_Per_Page As Long = 33

'this code will require a reference to Word
On Error GoTo ProcError

Dim appWord As Word.Application
Dim docNew As Word.Document
Dim oTable As Word.Table
Dim oRange As Word.Range
Dim fld As DAO.Field
Dim f As Long
Dim lngColumn As Long
Dim r As Long

'now lets see what we get with Word
On Error Resume Next

'delete file if exists
If LenB(Dir$(strFilePathAndName)) > 0 Then Kill strFilePathAndName

'Attempt to reference Word which may already be running.
Set appWord = GetObject(, "Word.Application")

If appWord Is Nothing Then
'Word is not running, better try and start it
Set appWord = CreateObject("Word.Application")

'Now if appWord Is Nothing, MS Word is not installed.
If appWord Is Nothing Then
MsgBox "MS Word is not installed on your computer"
GoTo ExitHere
End If
End If

'reset to regular error handling
On Error GoTo ProcError
With appWord
.Visible = True
Set docNew = .Documents.Add
Set oRange = docNew.Content
Set oTable = oRange.Tables.Add(oRange, _
rs.RecordCount + 1, rs.Fields.Count)
oTable.AutoFormat Format:=wdTableFormatClassic2
End With

With oTable
Do Until rs.EOF

' Table must have a header row
If rs.AbsolutePosition = 1 Then
.Rows(1).HeadingFormat = CLng(True)

' Insert table header row here
End If

' Force this row to start on a new page
If rs.AbsolutePosition Mod 33 = 0 Then
.Cell(rs.AbsolutePosition, lngColumn).Range. _
Paragraphs(1).PageBreakBefore = True
End If

' Transfer record to the table
For lngColumn = 1 To oTable.Columns.Count
.Cell(rs.AbsolutePosition, lngColumn).Range.Text = rs(lngColumn - 1)
Next
rs.MoveNext
Loop
End With

docNew.SaveAs strFilePathAndName

ExitHere:
appWord.Documents.Close
appWord.Quit

Set oTable = Nothing
Set appWord = Nothing

Exit Sub

ProcError:
Select Case Err.Number
Case Else
MsgBox "Unanticipated error " & Err.Number & " " & _
Err.Description & " Aborting!"
Stop
Resume 0 'Hit F8 to goto line with error
End Select
End Sub

I've added an extra row to your table to contain the header information. I don't know
what text you require in the header row so you'll need to add this. On every 33rd record
the code sets the Paragraph formatting to be "PageBreakBefore", this causes that row to
start on a new page.

Depending on the version of Office you intend to use you may wish to consider dumping the
DAO code for ADO. DAO is only there for compatibility.

HTH + Cheers - Peter

 

[Guest]

hi Peter
Thanks for your replay, but it seems i didn't make myself
clear.
I have, let's say 3 records,( actually it varied, can be
much more then 3 records). and for each record i have to
create a table of 33 rows and 4 colomns (constant)
each table has tobe located in a different page of the
active document.
my biggest problem is to rerange the new range, for the
new table, because such line:

Set oTable = oRange.Tables.Add(oRange, _
rs.RecordCount + 1, rs.Fields.Count)

gives the meassge 'oRange' can not be erase (or something
like this)
i hope you have the enrgy to write a detailed answer as
you wrote earlier
many many thanks in advance
joy

-----Original Message-----
Hi joy

Someone e;se (or was it you?) wanted to do the same

thing. Here's what I posted last

time, I hope it's of help to you:

Public Sub CreateWordTable(ByVal rs As DAO.Recordset, _
ByVal strFilePathAndName As String)

Const RECORDS_Per_Page As Long = 33

'this code will require a reference to Word
On Error GoTo ProcError

Dim appWord As Word.Application
Dim docNew As Word.Document
Dim oTable As Word.Table
Dim oRange As Word.Range
Dim fld As DAO.Field
Dim f As Long
Dim lngColumn As Long
Dim r As Long

'now lets see what we get with Word
On Error Resume Next

'delete file if exists
If LenB(Dir$(strFilePathAndName)) > 0 Then Kill strFilePathAndName

'Attempt to reference Word which may already be running.
Set appWord = GetObject(, "Word.Application")

If appWord Is Nothing Then
'Word is not running, better try and start it
Set appWord = CreateObject("Word.Application")

'Now if appWord Is Nothing, MS Word is not installed.
If appWord Is Nothing Then
MsgBox "MS Word is not installed on your computer"
GoTo ExitHere
End If
End If

'reset to regular error handling
On Error GoTo ProcError
With appWord
.Visible = True
Set docNew = .Documents.Add
Set oRange = docNew.Content
Set oTable = oRange.Tables.Add(oRange, _
rs.RecordCount + 1, rs.Fields.Count)
oTable.AutoFormat Format:=wdTableFormatClassic2
End With

With oTable
Do Until rs.EOF

' Table must have a header row
If rs.AbsolutePosition = 1 Then
.Rows(1).HeadingFormat = CLng(True)

' Insert table header row here
End If

' Force this row to start on a new page
If rs.AbsolutePosition Mod 33 = 0 Then
.Cell(rs.AbsolutePosition, lngColumn).Range. _
Paragraphs(1).PageBreakBefore = True
End If

' Transfer record to the table
For lngColumn = 1 To oTable.Columns.Count
.Cell(rs.AbsolutePosition,

lngColumn).Range.Text = rs(lngColumn - 1)

Next
rs.MoveNext
Loop
End With

docNew.SaveAs strFilePathAndName

ExitHere:
appWord.Documents.Close
appWord.Quit

Set oTable = Nothing
Set appWord = Nothing

Exit Sub

ProcError:
Select Case Err.Number
Case Else
MsgBox "Unanticipated error " & Err.Number & " " & _
Err.Description & " Aborting!"
Stop
Resume 0 'Hit F8 to goto line with error
End Select
End Sub

I've added an extra row to your table to contain the

header information. I don't know

what text you require in the header row so you'll need to

add this. On every 33rd record

the code sets the Paragraph formatting to

be "PageBreakBefore", this causes that row to

start on a new page.

Depending on the version of Office you intend to use you

may wish to consider dumping the

 

[Doug Robbins - Word MVP]

The following code will add a new page to the document and insert a table on
that page:

Dim oRange As Range, oTable As Table
Set oRange = ActiveDocument.Range
oRange.Collapse wdCollapseEnd
oRange.InsertBreak (wdPageBreak)
Set oTable = ActiveDocument.Tables.Add(oRange, rs.RecordCount + 1,
rs.Fields.Count)


--
Please post any further questions or followup to the newsgroups for the
benefit of others who may be interested. Unsolicited questions forwarded
directly to me will only be answered on a paid consulting basis.

Hope this helps
Doug Robbins - Word MVP

 

[joy]

Thank you doug very much
though i get an empty page at the begining of the document
how do i get rid of it
many many thanks again
joy

 

[Doug Robbins - Word MVP]

Try,

Dim oRange As Range, oTable As Table
Set oRange = ActiveDocument.Range
oRange.Collapse wdCollapseEnd
If oRange.Start <> ActiveDocument.Range.Start then
oRange.InsertBreak (wdPageBreak)
End If
Set oTable = ActiveDocument.Tables.Add(oRange, rs.RecordCount + 1,
rs.Fields.Count)


--
Please post any further questions or followup to the newsgroups for the
benefit of others who may be interested. Unsolicited questions forwarded
directly to me will only be answered on a paid consulting basis.

Hope this helps
Doug Robbins - Word MVP

 

[joy]

Doug
thank you so much
joy

-----Original Message-----
Try,

Dim oRange As Range, oTable As Table
Set oRange = ActiveDocument.Range
oRange.Collapse wdCollapseEnd
If oRange.Start <> ActiveDocument.Range.Start then
oRange.InsertBreak (wdPageBreak)
End If
Set oTable = ActiveDocument.Tables.Add(oRange, rs.RecordCount + 1,
rs.Fields.Count)


--
Please post any further questions or followup to the newsgroups for the
benefit of others who may be interested. Unsolicited questions forwarded
directly to me will only be answered on a paid consulting basis.

Hope this helps
Doug Robbins - Word MVP


.