[AccessD] Another word question...

There seems to be a dangling ENDIF, (after rs2.close) and I'm not sure where
it's IF should go.

-----Original Message-----
From: accessd-bounces at databaseadvisors.com
[mailto:accessd-bounces at databaseadvisors.com] On Behalf Of Bobby Heid
Sent: July 21, 2005 2:31 PM
To: 'Access Developers discussion and problem solving'
Subject: [AccessD] Another word question...

Me again,

I am generating 1-2 tables per page on this report that I'm doing in word
via automation.  It takes, on average, 1.8 seconds to create one page.  This
is an average from 406 pages.  In trying to make it faster, I have
determined that the table code takes 66% of the time it takes to create a
page.  Note that the tables can have a variable number of items in it.

I am including the relevant bits of code.  I know it is a lot to look
through so it's ok if you want to stop here.  The one second saved still has
the recordset stuff in it, so that is not the bottleneck.

Anyone have any ideas as to how I may speed this up?  I have included what a
finished table looks like at the end of this email.

Thanks,
Bobby

This is what I'm doing (for each table):
If Not rs2.EOF Then
               rs2.MoveLast
               rs2.MoveFirst
		   'add the table
               Set wrdTableWC = wrdDocTmp.Tables.Add(.Selection.Range,
rs2.RecordCount + 3, 3)
		   'format the table and create headers
               SetUpTable wrdApp, wrdTableWC, "Workers' Compensation", "WC",
rs2.RecordCount + 3
               End If
                            
               i = 3
               Do While Not rs2.EOF
                  With wrdTableWC
                     .Cell(i, 1).Range.Text = Nz(rs2![WC Description], "")
                     .Cell(i, 2).Range.Text = Nz(rs2![WC Code], "")
                     .Cell(i, 3).Range.Text = "$"
                     End With
                     
                  rs2.MoveNext
                  i = i + 1
                  Loop
                  
            rs2.Close
            End If

'set up the table by formatting cells and writing static text
Private Sub SetUpTable(ByRef wrdApp As Object, ByRef wrdTable As Object,
ByVal strTitle As String, _
   ByVal strType As String, ByVal lLast As Long)
Dim wrdRow  As Object

   On Error GoTo Proc_Err

            With wrdTable
               .Borders.InsideLineStyle = 1
'wdLineStyleSingle
               .Borders.OutsideLineStyle = 7
'wdLineStyleDouble
               .Columns(1).Width = 250
               .Columns(2).Width = 60
               .Columns(3).Width = 200
               End With
               
            '1st row set to caption
            Set wrdRow = wrdTable.Rows(1)
            wrdRow.cells.Merge
            wrdRow.Shading.Texture = 250           'wdTexture25Percent
            With wrdTable.Cell(1, 1).Range
               .Font.Size = 14
               .Font.Bold = True
               .Paragraphs.Alignment = 1         'wdAlignRowCenter
               End With
            WriteCell3 wrdApp, wrdTable, 1, 1, strTitle, False
               
            With wrdTable
               .Cell(2, 1).Range.Paragraphs.Alignment = 0
'wdAlignRowLeft
               .Cell(2, 2).Range.Paragraphs.Alignment = 1
'wdAlignRowCenter
               .Cell(2, 3).Range.Paragraphs.Alignment = 1
'wdAlignRowCenter
               .Cell(lLast, 1).Range.Paragraphs.Alignment = 2
'wdAlignRowRight
               .Cell(lLast, 2).Range.Shading.BackgroundPatternColorIndex =
16  'wdGray25
               End With
            WriteCell3 wrdApp, wrdTable, 2, 1, strType & " Classification
Description", True
            WriteCell3 wrdApp, wrdTable, 2, 2, strType & " Code", True
            WriteCell3 wrdApp, wrdTable, 2, 3, "Actual Payroll", True
            WriteCell3 wrdApp, wrdTable, lLast, 1, "Total", True
            WriteCell3 wrdApp, wrdTable, lLast, 3, "$", False

End sub 


'write a cell in the table
Private Sub WriteCell3(ByRef wrdApp As Object, ByRef wrdTable As Object, _
   ByVal x As Long, ByVal y As Long, ByVal strData As String, ByRef bBold As
Boolean)

   wrdTable.Cell(x, y).SELECT
   wrdApp.Selection.Font.Bold = bBold
   wrdApp.Selection.TypeText strData
   
End Sub



I hope this will come across to the list.
 
Workers' Compensation	
WC Classification Description	WC Code	Actual Payroll	
Stone Install	1803	$	
Tile Work	5348	$	
Carpentry	5437	$	
Carpet, Vinyl Install	5478	$	
Executive Supervisors	5606	$	
Total		$	

 
General Liablity	
GL Classification Description	GL Code	Actual Payroll	
Executive Supervisors	91580	$	
Floor Covering Install	94569	$	
Tile Install Interior	99746	$	
Total		$	

-- 
AccessD mailing list
AccessD at databaseadvisors.com
http://databaseadvisors.com/mailman/listinfo/accessd
Website: http://www.databaseadvisors.com