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

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

Sub Auto_fit_list_width()
    Dim startTime As Single, endTime As Single
    startTime = Timer  ' ⏱️ 开始计时
    
    Dim tbl As Table
    Dim colWidthsCm As Variant
    Dim colWidthsPt(0 To 5) As Single
    Dim i As Integer, r As Integer
    Dim totalWidthCm As Single, totalWidthPt As Single
    
    ' 列宽配置（厘米）
    colWidthsCm = Array(5.5, 5.5, 2, 3, 7, 1.5)
    
    totalWidthCm = 0
    For i = 0 To 5
        colWidthsPt(i) = CentimetersToPoints(colWidthsCm(i))
        totalWidthCm = totalWidthCm + colWidthsCm(i)
    Next i
    totalWidthPt = CentimetersToPoints(totalWidthCm)
    
    ' 边距（磅）— 预计算以提升性能
    Dim topP As Single: topP = 0
    Dim bottomP As Single: bottomP = 0
    Dim leftP As Single: leftP = CentimetersToPoints(0.19)
    Dim rightP As Single: rightP = CentimetersToPoints(0.19)
    
    ' 保存原始 Word 设置
    Dim originalAlerts As WdAlertLevel
    Dim originalSpell As Boolean, originalGrammar As Boolean, originalScreenUpdating As Boolean
    originalAlerts = Application.DisplayAlerts
    originalSpell = Application.Options.CheckSpellingAsYouType
    originalGrammar = Application.Options.CheckGrammarAsYouType
    originalScreenUpdating = Application.ScreenUpdating
    
    ' 关闭干扰项以加速执行
    Application.DisplayAlerts = wdAlertsNone
    Application.Options.CheckSpellingAsYouType = False
    Application.Options.CheckGrammarAsYouType = False
    Application.ScreenUpdating = False
    ActiveDocument.UndoClear
    
    ' 缓存所有表格
    Dim allTables As Collection: Set allTables = New Collection
    Dim tblTemp As Table
    For Each tblTemp In ActiveDocument.Tables
        allTables.Add tblTemp
    Next tblTemp
    
    Dim totalTables As Long: totalTables = allTables.Count
    If totalTables = 0 Then
        MsgBox "文档中没有表格。", vbExclamation
        GoTo Cleanup
    End If
    
    Dim processedCount As Long, batchSize As Long: batchSize = 10
    Dim rowCount As Long
    Dim cell As Cell
    
    For processedCount = 1 To totalTables
        Set tbl = allTables(processedCount)
        
        Dim actualColCount As Long
        On Error Resume Next
        actualColCount = tbl.Range.Columns.Count
        On Error GoTo 0
        If actualColCount <= 0 Then GoTo NextTable
        
        If actualColCount = 6 Then
            Dim useColumnMethod As Boolean: useColumnMethod = True
            On Error Resume Next
            For i = 1 To 6
                tbl.Columns(i).Width = colWidthsPt(i - 1)
            Next i
            If Err.Number = 5992 Then
                useColumnMethod = False
                Err.Clear
            End If
            On Error GoTo 0
            
            With tbl
                .AllowAutoFit = False
                .AutoFitBehavior wdAutoFitFixed
                .PreferredWidthType = wdPreferredWidthPoints
                .PreferredWidth = totalWidthPt
                .Rows.Alignment = wdAlignRowCenter
                .Rows.LeftIndent = 0
                .Rows.WrapAroundText = False
            End With
            
            rowCount = tbl.Rows.Count
            Dim rowObj As Row
            For r = 1 To rowCount
                Set rowObj = tbl.Rows(r)
                rowObj.AllowBreakAcrossPages = False
                
                If useColumnMethod Then
                    For Each cell In rowObj.Cells
                        SetCellPadding cell, topP, bottomP, leftP, rightP
                    Next cell
                Else
                    Select Case rowObj.Cells.Count
                        Case 6
                            For i = 0 To 5
                                SetCellPadding rowObj.Cells(i + 1), topP, bottomP, leftP, rightP
                                rowObj.Cells(i + 1).Width = colWidthsPt(i)
                            Next i
                        Case 1
                            SetCellPadding rowObj.Cells(1), topP, bottomP, leftP, rightP
                            rowObj.Cells(1).Width = totalWidthPt
                        Case Else
                            For Each cell In rowObj.Cells
                                SetCellPadding cell, topP, bottomP, leftP, rightP
                            Next cell
                    End Select
                End If
            Next r
        
        ElseIf actualColCount = 1 Then
            With tbl
                .AllowAutoFit = False
                .AutoFitBehavior wdAutoFitFixed
                .PreferredWidthType = wdPreferredWidthPoints
                .PreferredWidth = totalWidthPt
                .Rows.Alignment = wdAlignRowCenter
                .Rows.LeftIndent = 0
                .Rows.WrapAroundText = False
            End With
            
            On Error Resume Next
            tbl.Columns(1).Width = totalWidthPt
            If Err.Number = 5992 Then
                Err.Clear
                rowCount = tbl.Rows.Count
                For r = 1 To rowCount
                    If tbl.Rows(r).Cells.Count >= 1 Then
                        tbl.Rows(r).Cells(1).Width = totalWidthPt
                        SetCellPadding tbl.Rows(r).Cells(1), topP, bottomP, leftP, rightP
                    End If
                Next r
            End If
            On Error GoTo 0
            
            If Err.Number = 0 Then
                rowCount = tbl.Rows.Count
                For r = 1 To rowCount
                    With tbl.Rows(r)
                        .AllowBreakAcrossPages = True
                        If .Cells.Count >= 1 Then
                            SetCellPadding .Cells(1), topP, bottomP, leftP, rightP
                        End If
                    End With
                Next r
            End If
        End If
        
NextTable:
        Set tbl = Nothing
        If (processedCount Mod batchSize = 0) Or (processedCount = totalTables) Then
            Application.StatusBar = "正在格式化表格... 已完成 " & processedCount & " / " & totalTables
            DoEvents
        End If
    Next processedCount
    
Cleanup:
    endTime = Timer  ' ⏱️ 结束计时
    Dim elapsedSeconds As Single
    elapsedSeconds = Round(endTime - startTime, 2)  ' 保留两位小数的秒数
    
    Application.StatusBar = False
    Application.ScreenUpdating = originalScreenUpdating
    Application.DisplayAlerts = originalAlerts
    Application.Options.CheckSpellingAsYouType = originalSpell
    Application.Options.CheckGrammarAsYouType = originalGrammar
    
    If totalTables > 0 Then
        MsgBox "表格格式化已完成！共处理 " & totalTables & " 张表格。" & vbCrLf & _
               "耗时: " & elapsedSeconds & " 秒", vbInformation
    End 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 = rightP
    End With
End Sub