Q：Word 文档，vbs脚本，批量标准化表格（统一表格宽度、内边距及布局样式）

适用于需要批量规范表格格式的场景（如标准化报告、说明书等），避免手动调整多个表格的重复操作，提升文档格式统一性和处理效率。

Sub Auto_fit_list_width()Dim startTime As Single, endTime As SinglestartTime = Timer  ' ⏱️ 开始计时
    Dim tbl As TableDim colWidthsCm As VariantDim colWidthsPt(0 To 5) As SingleDim i As Integer, r As IntegerDim totalWidthCm As Single, totalWidthPt As Single' 列宽配置（厘米）colWidthsCm = Array(5.5, 5.5, 2, 3, 7, 1.5)totalWidthCm = 0For i = 0 To 5colWidthsPt(i) = CentimetersToPoints(colWidthsCm(i))totalWidthCm = totalWidthCm + colWidthsCm(i)Next itotalWidthPt = CentimetersToPoints(totalWidthCm)' 边距（磅）— 预计算以提升性能Dim topP As Single: topP = 0Dim bottomP As Single: bottomP = 0Dim leftP As Single: leftP = CentimetersToPoints(0.19)Dim rightP As Single: rightP = CentimetersToPoints(0.19)' 保存原始 Word 设置
    Dim originalAlerts As WdAlertLevelDim originalSpell As Boolean, originalGrammar As Boolean, originalScreenUpdating As BooleanoriginalAlerts = Application.DisplayAlertsoriginalSpell = Application.Options.CheckSpellingAsYouTypeoriginalGrammar = Application.Options.CheckGrammarAsYouTypeoriginalScreenUpdating = Application.ScreenUpdating' 关闭干扰项以加速执行Application.DisplayAlerts = wdAlertsNoneApplication.Options.CheckSpellingAsYouType = FalseApplication.Options.CheckGrammarAsYouType = FalseApplication.ScreenUpdating = FalseActiveDocument.UndoClear' 缓存所有表格Dim allTables As Collection: Set allTables = New CollectionDim tblTemp As TableFor Each tblTemp In ActiveDocument.TablesallTables.Add tblTempNext tblTempDim totalTables As Long: totalTables = allTables.CountIf totalTables = 0 ThenMsgBox "文档中没有表格。", vbExclamationGoTo CleanupEnd IfDim processedCount As Long, batchSize As Long: batchSize = 10Dim rowCount As LongDim cell As CellFor processedCount = 1 To totalTablesSet tbl = allTables(processedCount)Dim actualColCount As LongOn Error Resume NextactualColCount = tbl.Range.Columns.CountOn Error GoTo 0If actualColCount <= 0 Then GoTo NextTableIf actualColCount = 6 ThenDim useColumnMethod As Boolean: useColumnMethod = TrueOn Error Resume NextFor i = 1 To 6tbl.Columns(i).Width = colWidthsPt(i - 1)Next iIf Err.Number = 5992 ThenuseColumnMethod = FalseErr.ClearEnd IfOn Error GoTo 0With tbl.AllowAutoFit = False.AutoFitBehavior wdAutoFitFixed.PreferredWidthType = wdPreferredWidthPoints.PreferredWidth = totalWidthPt.Rows.Alignment = wdAlignRowCenter.Rows.LeftIndent = 0.Rows.WrapAroundText = FalseEnd WithrowCount = tbl.Rows.CountDim rowObj As RowFor r = 1 To rowCountSet rowObj = tbl.Rows(r)rowObj.AllowBreakAcrossPages = FalseIf useColumnMethod ThenFor Each cell In rowObj.CellsSetCellPadding cell, topP, bottomP, leftP, rightPNext cellElseSelect Case rowObj.Cells.CountCase 6For i = 0 To 5SetCellPadding rowObj.Cells(i + 1), topP, bottomP, leftP, rightProwObj.Cells(i + 1).Width = colWidthsPt(i)Next iCase 1SetCellPadding rowObj.Cells(1), topP, bottomP, leftP, rightProwObj.Cells(1).Width = totalWidthPtCase ElseFor Each cell In rowObj.CellsSetCellPadding cell, topP, bottomP, leftP, rightPNext cellEnd SelectEnd IfNext rElseIf actualColCount = 1 ThenWith tbl.AllowAutoFit = False.AutoFitBehavior wdAutoFitFixed.PreferredWidthType = wdPreferredWidthPoints.PreferredWidth = totalWidthPt.Rows.Alignment = wdAlignRowCenter.Rows.LeftIndent = 0.Rows.WrapAroundText = FalseEnd WithOn Error Resume Nexttbl.Columns(1).Width = totalWidthPtIf Err.Number = 5992 ThenErr.ClearrowCount = tbl.Rows.CountFor r = 1 To rowCountIf tbl.Rows(r).Cells.Count >= 1 Thentbl.Rows(r).Cells(1).Width = totalWidthPtSetCellPadding tbl.Rows(r).Cells(1), topP, bottomP, leftP, rightPEnd IfNext rEnd IfOn Error GoTo 0If Err.Number = 0 ThenrowCount = tbl.Rows.CountFor r = 1 To rowCountWith tbl.Rows(r).AllowBreakAcrossPages = TrueIf .Cells.Count >= 1 ThenSetCellPadding .Cells(1), topP, bottomP, leftP, rightPEnd IfEnd WithNext rEnd IfEnd IfNextTable:Set tbl = NothingIf (processedCount Mod batchSize = 0) Or (processedCount = totalTables) ThenApplication.StatusBar = "正在格式化表格... 已完成 " & processedCount & " / " & totalTablesDoEventsEnd IfNext processedCountCleanup:endTime = Timer  ' ⏱️ 结束计时
    Dim elapsedSeconds As SingleelapsedSeconds = Round(endTime - startTime, 2)  ' 保留两位小数的秒数
    Application.StatusBar = FalseApplication.ScreenUpdating = originalScreenUpdatingApplication.DisplayAlerts = originalAlertsApplication.Options.CheckSpellingAsYouType = originalSpellApplication.Options.CheckGrammarAsYouType = originalGrammarIf totalTables > 0 ThenMsgBox "表格格式化已完成！共处理 " & totalTables & " 张表格。" & vbCrLf & _"耗时: " & elapsedSeconds & " 秒", vbInformationEnd If
End Sub' === 提取的子过程：统一设置单元格内边距 ===
Private Sub SetCellPadding(ByRef c As Cell, _ByVal topP As Single, _ByVal bottomP As Single, _ByVal leftP As Single, _ByVal rightP As Single)With c.TopPadding = topP.BottomPadding = bottomP.LeftPadding = leftP.RightPadding = rightPEnd With
End Sub