Word VBA：修改表格单元格宽度后为何宽度不一致？

我有一个包含单元格合并（宽/高合并）的Word表格，无法直接访问单独的列或行。我已经通过循环遍历表格成功定位到每行的最后一个单元格，但尝试用以下代码设置宽度时，单元格宽度呈现阶梯状而非一致：

ActiveDocument.Tables(1).Cell(RowCurrent, ColCurrent).SetWidth _
ColumnWidth:=InchesToPoints(0.5), _
RulerStyle:=wdAdjustNone

修改前表格状态：

修改后表格状态：

注：最后几行无需修改，未做调整。

完整代码如下，求问宽度不一致的原因及解决方法：

Sub SizeCells()
    
    Dim RowInd As Integer, ColInd As Integer
    Dim oCell As Cell, CellLast As Cell
    Dim RowCurrent As Integer, ColCurrent As Integer, ColLast As Integer
    Dim ArrayRowCount As Integer
    Dim MyArray() As Integer
    Dim counter As Integer

    ActiveDocument.Tables(1).Select

    With Selection.Find
        .Forward = True
        .ClearFormatting
        .MatchWholeWord = True
        .MatchCase = False
        .Wrap = wdFindContinue
        .Execute FindText:="potential assessment methods and objects"
    End With

    RowInd = Selection.Information(wdEndOfRangeRowNumber)
    ColInd = Selection.Information(wdEndOfRangeColumnNumber)

    'ActiveDocument.Tables(1).Cell(RowInd, ColInd).Select

    ArrayRowCount = -1

    For Each oCell In ActiveDocument.Tables(1).Range.Cells

        If oCell.RowIndex = RowInd And oCell.ColumnIndex = ColInd Then Exit For

        ArrayRowCount = ArrayRowCount + 1

    Next oCell

    ReDim MyArray(ArrayRowCount, 1)

    counter = 0

    For Each oCell In ActiveDocument.Tables(1).Range.Cells

        If oCell.RowIndex = RowInd And oCell.ColumnIndex = ColInd Then Exit For

        'Debug.Print oCell.RowIndex ; " "; oCell.ColumnIndex

        MyArray(counter, 0) = oCell.RowIndex
        MyArray(counter, 1) = oCell.ColumnIndex

        counter = counter + 1

    Next oCell

    For i = 0 To (ArrayRowCount - 1)
 
        RowCurrent = MyArray(i, 0)

        If RowCurrent <= MyArray(i + 1, 0) Then
            ColCurrent = MyArray(i, 1)

            'Last cell value in row has been found
            If ColCurrent > MyArray(i + 1, 1) Then
                ActiveDocument.Tables(1).Cell(RowCurrent, ColCurrent).SetWidth _
                ColumnWidth:=InchesToPoints(0.5), _
                RulerStyle:=wdAdjustNone

            End If
        End If

    Next i
    
End Sub

使用wdAdjustNone作为RulerStyle参数时，Word仅调整目标单元格的宽度，不会自动协调表格整体布局。但存在单元格合并的表格中，每行总宽度是相互关联的——前面行调整后，后续行的可用宽度会被挤压，导致后续设置的单元格实际宽度被压缩，最终呈现阶梯状。

替换RulerStyle参数为wdAdjustFirstColumn，同时优化定位最后一个单元格的逻辑，避免冗余的数组操作：

优化后的代码 #

Sub SizeLastCellsConsistently()
    Dim tbl As Table
    Dim targetRowEnd As Integer
    Dim oRow As Row
    Dim lastCell As Cell
    
    Set tbl = ActiveDocument.Tables(1)
    
    ' 定位到目标结束行（通过查找文本）
    With tbl.Range.Find
        .Forward = True
        .ClearFormatting
        .MatchWholeWord = True
        .MatchCase = False
        .Wrap = wdFindStop
        .Execute FindText:="potential assessment methods and objects"
    End With
    
    If .Found Then
        targetRowEnd = tbl.Range.Information(wdEndOfRangeRowNumber)
    Else
        targetRowEnd = tbl.Rows.Count ' 如果没找到，默认处理所有行
    End If
    
    ' 遍历每行，设置最后一个单元格宽度
    For Each oRow In tbl.Rows
        If oRow.Index >= targetRowEnd Then Exit For ' 跳过不需要修改的行
        
        Set lastCell = oRow.Cells(oRow.Cells.Count)
        ' 使用wdAdjustFirstColumn确保仅调整当前单元格所在列，保持宽度一致
        lastCell.SetWidth ColumnWidth:=InchesToPoints(0.5), RulerStyle:=wdAdjustFirstColumn
    Next oRow
End Sub

关键修改说明 #

1. 简化定位逻辑：直接通过Row.Cells.Count获取每行最后一个单元格，无需数组存储和复杂判断，代码更简洁高效
2. 调整RulerStyle参数：wdAdjustFirstColumn会让Word自动调整目标单元格对应的列宽度，避免后续行的宽度被挤压，保证所有目标单元格宽度一致
3. 优化查找逻辑：使用wdFindStop防止循环查找，提升执行效率

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