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

2024-07-11 18:47| 来源: 网络整理| 查看: 265

标签：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

【本文地址】

公司简介

联系我们