Mike Faulkner was telling us:
Mike Faulkner nous racontait que :
Hello
Windows XP
Word 2002 & 2003
Using VBA I want to run 'Table|AutoFit|AutoFit to Window' on any
table in a document which overlaps the left or right margin. I am
having trouble finding out a tables left and right position from
either margin. Any suggestions will be much appreciated.
I have searched the database but not found the code I am looking for.
I have code for:
1. Looping through the Tables collection
2. Extracting the left & right margins for each section
There are two problems with getting table width, one for which I can offer a
solution and the other I
cannot...
First, if the table has columns that have user-set width, .PreferredWidth
will return 999999. This can be detected and we can get around that, as in
my example below.
Second, if you encounter the first case and then have to use the workaround,
if there are merged cells in the table, it is possible that an error be
generated.
'_______________________________________
Option Explicit
'_______________________________________
Sub Adjust_Tables()
Dim tblToCheck As Table
Dim lngSectionWidth As Long
Dim lngTableWidth As Long
For Each tblToCheck In ActiveDocument.Tables
With tblToCheck.Range.Sections(1).PageSetup
lngSectionWidth = (.PageWidth - (.LeftMargin + .RightMargin))
End With
lngTableWidth = tblWidth(tblToCheck)
If lngTableWidth > lngSectionWidth Then
With tblToCheck
.PreferredWidthType = wdPreferredWidthPercent
.PreferredWidth = 100
.Rows.LeftIndent = 0
End With
End If
Next
End Sub
'_______________________________________
'_______________________________________
Private Function tblWidth(myTable As Table) As Long
Dim TableWidthType As Long
Dim TableWidth As Single
With myTable
'Save current setting
TableWidthType = .PreferredWidthType
'Apply width type in absolute, not relative percentage
.PreferredWidthType = wdPreferredWidthPoints
'Get width
If .PreferredWidth = 9999999 Then
TableWidth = CSng(GetSpecialWidth(myTable))
If TableWidth = 0 Then Exit Function
Else
TableWidth = .PreferredWidth
End If
'Reset width type
.PreferredWidthType = TableWidthType
'Limit to 2 digits after deciaml point
tblWidth = TableWidth
End With
End Function
'_______________________________________
'_______________________________________
Private Function GetSpecialWidth(myTable As Table) As Long
Dim TableWidth As Long
Dim lngCount As Long
On Error GoTo DealError
With myTable
For lngCount = 1 To .Columns.Count
TableWidth = TableWidth + .Cell(1, lngCount).Width
Next
End With
GetSpecialWidth = TableWidth
Exit Function
On Error GoTo 0
DealError:
Err.Clear
MsgBox "The table width cannot be calculated, probably because there " _
& "are merged cells in the table.", vbCritical, _
"Cannot compute width"
On Error GoTo 0
End Function
'_______________________________________
--
Salut!
_______________________________________
Jean-Guy Marcil - Word MVP
(e-mail address removed)
Word MVP site:
http://www.word.mvps.org