Changing size of multiple tables

[Guest]

I have six huge Word 2003 documents with many tables in it that are too wide.
I need to change every one to, say, 18cm wide. Can it be done with a macro
in each doc? I have already changed two documents and it has taken me ages
to select and reduce each table. Again, this will save me precious time and
lots of pain in my right hand.

 

[Henk57]

I dont know about a macro, but if your tables have an assigned style
with defined attributes you can change it there and it should then be a
one time change.
HTH - Henk

 

[macropod]

Hi Sparrahart,

The following macro fits all tables in a document to a maximum permitted width of 18cm:

Sub TableResizer()
Application.ScreenUpdating = False
Dim oTableWidth As Single
Dim tTableWidth As Single
Dim oTbl As Table
Dim oCol As Column
' Maximum table width
tTableWidth = CentimetersToPoints(18)
' Exit if there's no tables
If ActiveDocument.Tables.Count = 0 Then Exit Sub
' Test all tables
For Each oTbl In ActiveDocument.Tables
' Calculate the current table's width
oTableWidth = 0
For Each oCol In oTbl.Columns
oTableWidth = oTableWidth + oCol.Width
Next oCol
' Compare against maximum table width
If oTableWidth > tTableWidth Then
' Turn off auto sizing & preferred width for oversize tables
With oTbl
.AllowAutoFit = False
.PreferredWidth = 0
End With
' Scale each column's width to fit
For Each oCol In oTbl.Columns
oCol.Width = oCol.Width * tTableWidth / oTableWidth
Next oCol
End If
Next oTbl
Application.ScreenUpdating = True
End Sub

Depending on the amount of text in each cell, you may end up with some of the tables getting longer. To overcome that, you'd
probably need to reduce the font sizes.

Cheers

 

[Guest]

This worked perfectly except I should have mentioned that the table has to be
centred, not default left, on the page. Can you help me out one more time.
I think it is fantastic what you have done. Saved me heaps of time.

Thanks,
Lyn

Hi Sparrahart,

The following macro fits all tables in a document to a maximum permitted width of 18cm:

Sub TableResizer()
Application.ScreenUpdating = False
Dim oTableWidth As Single
Dim tTableWidth As Single
Dim oTbl As Table
Dim oCol As Column
' Maximum table width
tTableWidth = CentimetersToPoints(18)
' Exit if there's no tables
If ActiveDocument.Tables.Count = 0 Then Exit Sub
' Test all tables
For Each oTbl In ActiveDocument.Tables
' Calculate the current table's width
oTableWidth = 0
For Each oCol In oTbl.Columns
oTableWidth = oTableWidth + oCol.Width
Next oCol
' Compare against maximum table width
If oTableWidth > tTableWidth Then
' Turn off auto sizing & preferred width for oversize tables
With oTbl
.AllowAutoFit = False
.PreferredWidth = 0
End With
' Scale each column's width to fit
For Each oCol In oTbl.Columns
oCol.Width = oCol.Width * tTableWidth / oTableWidth
Next oCol
End If
Next oTbl
Application.ScreenUpdating = True
End Sub

Depending on the amount of text in each cell, you may end up with some of the tables getting longer. To overcome that, you'd
probably need to reduce the font sizes.

Cheers
--
macropod
[MVP - Microsoft Word]
-------------------------

I have six huge Word 2003 documents with many tables in it that are too wide.
I need to change every one to, say, 18cm wide. Can it be done with a macro
in each doc? I have already changed two documents and it has taken me ages
to select and reduce each table. Again, this will save me precious time and
lots of pain in my right hand.

 

[macropod]

Hi Sparrahart,

The code I posted doesn't do anything tho change your table alignment - the errant tables must already have been centered. No
matter, this can be fixed in one of two ways:
1. If you want to change the alignment of only the oversized tables, change:

With oTbl
.AllowAutoFit = False
.PreferredWidth = 0
End With

to:

With oTbl
.AllowAutoFit = False
.PreferredWidth = 0
.Rows.Alignment = wdAlignRowLeft
.Rows.LeftIndent = CentimetersToPoints(0)
End With

2. If you want to left-align all tables, change:

End If
Next oTbl

to:

End If
With oTbl.Rows
.Alignment = wdAlignRowLeft
.LeftIndent = CentimetersToPoints(0)
End With
Next oTbl

Cheers
--
macropod
[MVP - Microsoft Word]
-------------------------

This worked perfectly except I should have mentioned that the table has to be
centred, not default left, on the page. Can you help me out one more time.
I think it is fantastic what you have done. Saved me heaps of time.

Thanks,
Lyn

Hi Sparrahart,

The following macro fits all tables in a document to a maximum permitted width of 18cm:

Sub TableResizer()
Application.ScreenUpdating = False
Dim oTableWidth As Single
Dim tTableWidth As Single
Dim oTbl As Table
Dim oCol As Column
' Maximum table width
tTableWidth = CentimetersToPoints(18)
' Exit if there's no tables
If ActiveDocument.Tables.Count = 0 Then Exit Sub
' Test all tables
For Each oTbl In ActiveDocument.Tables
' Calculate the current table's width
oTableWidth = 0
For Each oCol In oTbl.Columns
oTableWidth = oTableWidth + oCol.Width
Next oCol
' Compare against maximum table width
If oTableWidth > tTableWidth Then
' Turn off auto sizing & preferred width for oversize tables
With oTbl
.AllowAutoFit = False
.PreferredWidth = 0
End With
' Scale each column's width to fit
For Each oCol In oTbl.Columns
oCol.Width = oCol.Width * tTableWidth / oTableWidth
Next oCol
End If
Next oTbl
Application.ScreenUpdating = True
End Sub

Depending on the amount of text in each cell, you may end up with some of the tables getting longer. To overcome that, you'd
probably need to reduce the font sizes.

Cheers
--
macropod
[MVP - Microsoft Word]
-------------------------

I have six huge Word 2003 documents with many tables in it that are too wide.
I need to change every one to, say, 18cm wide. Can it be done with a macro
in each doc? I have already changed two documents and it has taken me ages
to select and reduce each table. Again, this will save me precious time and
lots of pain in my right hand.

 

[Guest]

Dear Macropod,

What a saviour you are! I actually wanted them all centred so just adjusted
your macro to Centre instead of Left and it worked. You are teaching me a
little about macros along the way. One day I just might try and understand
the macro language. I can record them okay (I come from the DOS days -
before Windows) but the lingo in creating them is a bit befuddling.

Thanks once again.

As a PS, this work has been created by someone else and I am having to
reformat it all. Very time consuming.

Hi Sparrahart,

The code I posted doesn't do anything tho change your table alignment - the errant tables must already have been centered. No
matter, this can be fixed in one of two ways:
1. If you want to change the alignment of only the oversized tables, change:

With oTbl
.AllowAutoFit = False
.PreferredWidth = 0
End With

to:

With oTbl
.AllowAutoFit = False
.PreferredWidth = 0
.Rows.Alignment = wdAlignRowLeft
.Rows.LeftIndent = CentimetersToPoints(0)
End With

2. If you want to left-align all tables, change:

End If
Next oTbl

to:

End If
With oTbl.Rows
.Alignment = wdAlignRowLeft
.LeftIndent = CentimetersToPoints(0)
End With
Next oTbl

Cheers
--
macropod
[MVP - Microsoft Word]
-------------------------

This worked perfectly except I should have mentioned that the table has to be
centred, not default left, on the page. Can you help me out one more time.
I think it is fantastic what you have done. Saved me heaps of time.

Thanks,
Lyn

Hi Sparrahart,

The following macro fits all tables in a document to a maximum permitted width of 18cm:

Sub TableResizer()
Application.ScreenUpdating = False
Dim oTableWidth As Single
Dim tTableWidth As Single
Dim oTbl As Table
Dim oCol As Column
' Maximum table width
tTableWidth = CentimetersToPoints(18)
' Exit if there's no tables
If ActiveDocument.Tables.Count = 0 Then Exit Sub
' Test all tables
For Each oTbl In ActiveDocument.Tables
' Calculate the current table's width
oTableWidth = 0
For Each oCol In oTbl.Columns
oTableWidth = oTableWidth + oCol.Width
Next oCol
' Compare against maximum table width
If oTableWidth > tTableWidth Then
' Turn off auto sizing & preferred width for oversize tables
With oTbl
.AllowAutoFit = False
.PreferredWidth = 0
End With
' Scale each column's width to fit
For Each oCol In oTbl.Columns
oCol.Width = oCol.Width * tTableWidth / oTableWidth
Next oCol
End If
Next oTbl
Application.ScreenUpdating = True
End Sub

Depending on the amount of text in each cell, you may end up with some of the tables getting longer. To overcome that, you'd
probably need to reduce the font sizes.

Cheers
--
macropod
[MVP - Microsoft Word]
-------------------------

I have six huge Word 2003 documents with many tables in it that are too wide.
I need to change every one to, say, 18cm wide. Can it be done with a macro
in each doc? I have already changed two documents and it has taken me ages
to select and reduce each table. Again, this will save me precious time and
lots of pain in my right hand.