Word中3列表格列宽设置VBA脚本偶发失效，求替代方案

问题说明 #

需要批量调整Word文档中450个3列表格的列宽（剩余50个为其他格式表格需排除）。目标表格顶部有带合并单元格的多行问题行，下方是3列数据：

• 问题行仅1行时，原脚本生效
• 问题行多行时，列宽数值在属性中显示正确，但视觉上不对齐，只需点击「下一列」对话框按钮（无需修改）即可自动修正，推测是Word布局Bug

原使用脚本 #

Sub SetTableWidthStrictly()
    Dim tbl As Table
    Dim tableRow As Row
    
    ' Loop through each table in the document
    For Each tbl In ActiveDocument.Tables
        ' Check if the table has three columns
        If tbl.Columns.Count = 3 Then
            ' Loop through each row in the table
            For Each tableRow In tbl.Rows
                If tableRow.Cells.Count = 3 Then
                   ' Set the width of each cell strictly
                   tableRow.Cells(1).PreferredWidthType = wdPreferredWidthPoints
                   tableRow.Cells(1).PreferredWidth = 332
                   
                   tableRow.Cells(2).PreferredWidthType = wdPreferredWidthPoints
                   tableRow.Cells(2).PreferredWidth = 55
                   
                   tableRow.Cells(3).PreferredWidthType = wdPreferredWidthPoints
                   tableRow.Cells(3).PreferredWidth = 81
                End If
            Next tableRow
        End If
    Next tbl
End Sub

优化后的可靠脚本 #

Sub FixThreeColumnTableWidths()
    Dim tbl As Table
    Dim targetTotalWidth As Single
    
    ' 计算目标总宽度（332+55+81）
    targetTotalWidth = 332 + 55 + 81
    
    For Each tbl In ActiveDocument.Tables
        ' 仅处理3列的表格
        If tbl.Columns.Count = 3 Then
            ' 设置表格整体为固定宽度模式，避免自动调整干扰
            tbl.PreferredWidthType = wdPreferredWidthPoints
            tbl.PreferredWidth = targetTotalWidth
            
            ' 直接设置每一列的固定宽度
            With tbl.Columns(1)
                .PreferredWidthType = wdPreferredWidthPoints
                .PreferredWidth = 332
            End With
            With tbl.Columns(2)
                .PreferredWidthType = wdPreferredWidthPoints
                .PreferredWidth = 55
            End With
            With tbl.Columns(3)
                .PreferredWidthType = wdPreferredWidthPoints
                .PreferredWidth = 81
            End With
            
            ' 强制锁定列宽布局，刷新表格
            tbl.AutoFitBehavior wdAutoFitFixed
            ' 触发内部布局校验，模拟手动点击"下一列"的修复效果
            tbl.Cells(1).Width = tbl.Cells(1).Width
        End If
    Next tbl
End Sub

优化要点 #

• 放弃逐行设置单元格宽度，改为直接操作表格列，避免合并行导致的行级宽度冲突
• 先固定表格整体宽度，确保列宽总和匹配，防止Word自动调整布局
• 用AutoFitBehavior wdAutoFitFixed强制锁定列宽，避免后续自动变化
• 通过重新赋值单元格宽度触发Word内部布局刷新，解决属性正确但显示异常的Bug

内容的提问来源于stack exchange，提问作者pgrisham