Word VBA技术：快速调整表格大小以适应页面宽度

fanjy

发布于 2023-02-24 12:45:30

2.1K00

代码可运行

文章被收录于专栏：完美Excel完美Excel

运行总次数：0

代码可运行

标签：Word VBA

有时候，文档中的表格有大有小且并不一定与页面同宽，或者页面宽度调整之后，表格仍保持原样。如果我们想将表格的大小调整为与页面宽度相同，并且保持各列单元格中原有的相对列宽，那么可以使用VBA来解决。

代码清单如下：

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