Setting Table Column Widths in VBA

[Terry]

I have a template that contains a table consisting of 1 row and 7 columns.
The columns have been set to the witdths I required within the table. The
table has a Bookmark in the first row first column, POLine.

I am looping through a recordset and filling the cells, this appears to work
OK. However the column widths are lost. How do I keep the column widths
fixed.

Regards

If objWord.ActiveDocument.Tables.Count >= 1 Then
Set myTable = objWord.ActiveDocument.Tables(1)
myTable.PreferredWidth = 0
'Selection.Tables(1).Columns(1).PreferredWidth =
InchesToPoints(1.25)
'Selection.Tables(1).Columns(2).PreferredWidth =
InchesToPoints(5)
' hide borders
With myTable.Borders
.InsideLineStyle = wdLineStyleNone
.OutsideLineStyle = wdLineStyleNone
End With
End If

'''''' Fill the Cells
Dim i As Integer
Do Until rstOUT.EOF = True
i = rstOUT.AbsolutePosition + 1
With rstOUT
intRowCount = Format$(!SortOrder, "00")
strGoodsServices = !GoodsServices
strLineQuantity = Format$(!LineQuantity, "0")
strLineAgreedFeeExcVAT = "£" &
Format$(!PriceAgreedFeeExcVat, "0.00")
strLineVATPercent = Format$(!VatPercent, "0.00")
strLineVATAmount = "£" & Format$(!VATAmount, "0.00")
strLineAgreedFeeIncVat = "£" &
Format$(!PriceAgreedFeeIncVAT, "0.00")

'''' New row
objWord.ActiveDocument.Bookmarks("POLine").Range.Rows.Add
With objWord.ActiveDocument.Tables(1).Cell(Row:=i,
Column:=1).Range
.Bold = False
.InsertAfter Text:=intRowCount
End With
With objWord.ActiveDocument.Tables(1).Cell(Row:=i,
Column:=2).Range
.Bold = False
.InsertAfter Text:=strGoodsServices
End With
With objWord.ActiveDocument.Tables(1).Cell(Row:=i,
Column:=3).Range
.Bold = False
.InsertAfter Text:=strLineQuantity
End With
With objWord.ActiveDocument.Tables(1).Cell(Row:=i,
Column:=4).Range
.Bold = False
.InsertAfter Text:=strLineAgreedFeeExcVAT
End With
With objWord.ActiveDocument.Tables(1).Cell(Row:=i,
Column:=5).Range
.Bold = False
.InsertAfter Text:=strLineVATPercent
End With
With objWord.ActiveDocument.Tables(1).Cell(Row:=i,
Column:=6).Range
.Bold = False
.InsertAfter Text:=strLineVATAmount
End With
With objWord.ActiveDocument.Tables(1).Cell(Row:=i,
Column:=7).Range
.Bold = False
.InsertAfter Text:=strLineAgreedFeeIncVat
End With
End With
rstOUT.MoveNext
Loop
' make word document visible
objWord.Visible = True

 

[Doug Robbins - Word MVP]

Use:

Dim mytable As Table
If objWord.ActiveDocument.Tables.Count >= 1 Then
Set myTable = objWord.ActiveDocument.Tables(1)
With mytable
.AutoFitBehavior wdAutoFitFixed
.Columns(1).Width = InchesToPoints(1.25)
.Columns(2).PreferredWidth = InchesToPoints(5)
With .Borders
.InsideLineStyle = wdLineStyleNone
.OutsideLineStyle = wdLineStyleNone
End With
End With
End If
'etc.

--
Hope this helps.

Please reply to the newsgroup unless you wish to avail yourself of my
services on a paid consulting basis.

Doug Robbins - Word MVP, originally posted via msnews.microsoft.com

 

[Terry]

Hi Doug,

OK, I now have the following code, but get an error 0 which is not
particularly helpful.
I have tried .width and .preferredwidth with the same result.
I need to see these column sizes, so I guess the first question is; how
should the table be correctly setup in the template to achieve what I need
to do?
Note, the first time I ran the code with just the 2 lines of width settings
from your example, it worked.
Regards

If objWord.ActiveDocument.Tables.Count >= 1 Then
Set myTable = objWord.ActiveDocument.Tables(1)
'myTable.PreferredWidth = 0
With myTable
.AutoFitBehavior wdAutoFitFixed
.Columns(1).Width = InchesToPoints(0.25)
.Columns(2).Width = InchesToPoints(4)
.Columns(3).Width = InchesToPoints(0.25)
.Columns(4).Width = InchesToPoints(1)
.Columns(5).Width = InchesToPoints(0.5)
.Columns(6).Width = InchesToPoints(1)
.Columns(7).PreferredWidth = InchesToPoints(1)
With .Borders
.InsideLineStyle = wdLineStyleNone
.OutsideLineStyle = wdLineStyleNone
End With
End With

 

[Terry]

Hi Doug,

The code below works OK one time, after that it errors on the line I have
marked. Not sure why as the error code is 0 which leaves winword.exe process
running hidden which I have to use TaskManager to stop the process.

I tried late vs early binding with the same result.

It's like something is left hanging around.

Further, do I need to have a bookmark in the table to be able to add rows?
Is there a better way than this:
objWord.ActiveDocument.Bookmarks("POLine").Range.Rows.Add

Is it best to add rows and insert cell contents before or after sizing the
columns?

Regards


' create new Word doc based on template
Set objWord = Nothing
On Error Resume Next
Set objWord = GetObject(, "Word.Application")
If Err.Number = 429 Then
' Word is not already open, create new Word object
'Set objWord = CreateObject("Word.Application")
Set objWord = New Word.Application
Err.Clear
End If
' redirect error handler
On Error GoTo error_handler
' open new Word document based on stored template; make visible
objWord.Documents.Add _
Application.CurrentProject.Path & DocumentFileName
' Fill the document header
With objWord.ActiveDocument.Bookmarks
.Item("OrderNumber").Range.Text = strOrderNumber
.Item("OrderDate").Range.Text = strOrderdate
.Item("SupplierConsultant").Range.Text = strSupplierConsultant
.Item("ProjectName").Range.Text = strProjectName
.Item("ProjectNumber").Range.Text = strProjectNumber
.Item("PaymentTerms").Range.Text = strPaymentTerms
.Item("ClientName").Range.Text = strClientname
.Item("OrderedBy").Range.Text = strOrderedBy
End With

' prepare word table to accept data
If objWord.ActiveDocument.Tables.Count >= 1 Then
Set myTable = objWord.ActiveDocument.Tables(1)
With myTable
.AutoFitBehavior wdAutoFitFixed
.Columns(1).Width = InchesToPoints(0.25) ****** ERROR HERE
.Columns(2).Width = InchesToPoints(2)
.Columns(3).Width = InchesToPoints(0.4)
.Columns(4).Width = InchesToPoints(0.75)
.Columns(5).Width = InchesToPoints(0.5)
.Columns(6).Width = InchesToPoints(0.75)
.Columns(7).PreferredWidth = InchesToPoints(1)
With .Borders
.InsideLineStyle = wdLineStyleNone
.OutsideLineStyle = wdLineStyleNone
End With
End With
End If

 

[Doug Robbins - Word MVP]

If you are creating the document from a template containing the table, why
don't you format the table in the template so that the columns widths are as
required?

--
Hope this helps.

Please reply to the newsgroup unless you wish to avail yourself of my
services on a paid consulting basis.

Doug Robbins - Word MVP, originally posted via msnews.microsoft.com

 

[Terry]

Hi Doug,

That got rid of the error, thank you. The relevent code is now:

' prepare word table to accept data
If objWord.ActiveDocument.Tables.Count >= 1 Then
Set myTable = objWord.ActiveDocument.Tables(1)
With myTable
.AutoFitBehavior wdAutoFitFixed
With .Borders
.InsideLineStyle = wdLineStyleNone
.OutsideLineStyle = wdLineStyleNone
End With
End With
End If

How can I shorten the following code to neaten it up? I can see where
myTable would fit, anything else?

objWord.ActiveDocument.Bookmarks("POLine").Range.Rows.Add
With objWord.ActiveDocument.Tables(1).Cell(Row:=1, Column:=1).Range
.Bold = True
.Font.Size = 10
.InsertAfter Text:=""
End With
With objWord.ActiveDocument.Tables(1).Cell(Row:=1, Column:=2).Range
.Bold = True
.Font.Size = 10
.InsertAfter Text:="Item Description"
End With
With objWord.ActiveDocument.Tables(1).Cell(Row:=1,
Column.............
etc...............

Regards

 

[Doug Robbins - Word MVP]

You could shorten it to:

Dim myDoc As Document
Dim myTable As Table
Set myDoc = objWord.ActiveDocument
Set myTable = myDoc.Tables(1)
With myTable
.Rows.Add
With .Cell(1, 1).Range
.Bold = True
.Font.Size = 10
End With
With .Cell(1, 2).Range
.Bold = True
.Font.Size = 10
.Text = "Item Description"
End With
End With


--
Hope this helps.

Please reply to the newsgroup unless you wish to avail yourself of my
services on a paid consulting basis.

Doug Robbins - Word MVP, originally posted via msnews.microsoft.com

 

[Terry]

Thanks for your help Doug, all works OK now.
Regards