标签：Word VBA
有时候，文档中的表格有大有小且并不一定与页面同宽，或者页面宽度调整之后，表格仍保持原样。如果我们想将表格的大小调整为与页面宽度相同，并且保持各列单元格中原有的相对列宽，那么可以使用VBA来解决。
代码清单如下：
代码语言：javascript复制Sub AdjustTableSizeFitPage()
Dim objTable As Table
Dim objRange As Range
Dim objRow As Row
Dim objCell As Cell
Dim sglUsableWidth As Single
Dim sglTableWidth As Single
Dim lngCellNum As Long
If Selection.Tables.Count = 0 Then
MsgBox "请将光标置于表格内并重试.",vbInformation
Exit Sub
End If
Application.ScreenUpdating = False
System.Cursor = wdCursorWait
Set objRange = Selection.Range
Set objTable = Selection.Tables(1)
objTable.Rows.SetLeftIndent LeftIndent:=0,RulerStyle:=wdAdjustNone
'计算页面已使用的宽度
With ActiveDocument.PageSetup
sglUsableWidth = .PageWidth - .LeftMargin - .RightMargin
End With
'计算顶部行宽度
'假设其与表格宽度相同
On Error Resume Next
For lngCellNum = 1 To objTable.Rows(1).Cells.Count
If Err = 5991 Then
MsgBox "程序不会处理有垂直合并单元格的表格.",vbInformation
GoTo CleanUp
ElseIf Err Then
MsgBox Err.Description,vbInformation
GoTo CleanUp
End If
sglTableWidth = sglTableWidth objTable.Rows(1).Cells(lngCellNum).Width
Next lngCellNum
On Error GoTo 0
'计算并分配每行中每个单元格的宽度,
'使单元格宽度相对于表宽度保持不变.
'对每一行单独执行,而不是一次对一列执行,
'否则,如果任何行包含水平合并的单元格,程序将无法工作
For Each objRow In objTable.Rows
For Each objCell In objRow.Cells
objCell.Width = (objCell.Width) * (sglUsableWidth / sglTableWidth)
Next objCell
Next objRow
objRange.Select
CleanUp:
Set objTable = Nothing
Set objRange = Nothing
Set objRow = Nothing
Set objCell = Nothing
sglUsableWidth = 0
sglTableWidth = 0
lngCellNum = 0
System.Cursor = wdCursorNormal
Application.ScreenUpdating = True
End Sub
