VBA实现根据表格中文字的行数设置不同的对齐方式

偶然翻看博客《使用VBA操作word表格》，climb_hero在下面提了个问题：表格单元格只有1行就居中，多行就左对齐的VBA语句如何写？问题已过去一年，居然没有人做回复。本想直接在下面用代码回复，奈何字符数量过多，只好单独写成一篇博客。

要解决climb_hero的问题，其实关键在于判断单元格中文字的行数。如果单元格中段落数大于1，自然是多行。问题是单元格中只有一个段落，怎么确定这个段落是不是分成了多行？如果是普通段落，要计算段落的行数是一件简单的事，只需调用range对象的ComputeStatistics(WdStatistic.wdStatisticLines)方法即可：

Set myRange = ActiveDocument.Paragraphs(1).Range
MsgBox myRange.ComputeStatistics(WdStatistic.wdStatisticLines)

但是表格单元格中文字的行数，cell.Range.ComputeStatistics(WdStatistic.wdStatisticLines)方法或者cell.Range.Paragraphs(1).Range.ComputeStatistics(WdStatistic.wdStatisticLines)方法都不能返回正确的结果，其原因只能猜测，估计是相同的文字在单元格的宽度变化时行数也会变化，且单元格格中还可能有多个段落，ComputeStatistics(WdStatistic.wdStatisticLines)方法的实现没有考虑这么复杂的情况。对于表格单元格中文字的行数，可以用如下函数计算得出：

Function 表格单元格中的行数(cell As cell)
    Dim lineStart, lineEnd As Long
    With cell.Range
        .MoveEnd wdCharacter, -1
        lineStart = .Information(wdFirstCharacterLineNumber)
        .Collapse wdCollapseEnd'折叠后range到了下一段的开头
        lineEnd = .Information(wdFirstCharacterLineNumber)
    End With
    表格单元格中的行数 = lineEnd - lineStart + 1
End Function

因此，实现climb_hero提出的需求的VBA代码如下：

Sub 根据表格中文字的行数设置对齐方式()
    Dim aCell As cell, lines, lineStart, lineEnd As Long
    For Each aCell In ActiveDocument.Tables(1).Range.Cells
        With aCell.Range
            .Cells.VerticalAlignment = wdCellAlignVerticalCenter '竖直居中
            If .Paragraphs.Count > 1 Then '段落数大于1，则必然多行
                 .ParagraphFormat.Alignment = wdAlignParagraphLeft '水平靠左
            Else
                '单元格中只有一个段落，则计算行数
                .MoveEnd wdCharacter, -1
                lineStart = .Information(wdFirstCharacterLineNumber)
                .Collapse wdCollapseEnd
                lineEnd = .Information(wdFirstCharacterLineNumber)
                lines = lineEnd - lineStart + 1
                If lines > 1 Then '多行则水平靠左
                     .ParagraphFormat.Alignment = wdAlignParagraphLeft '水平靠左
                Else '一行则水平居中
                    .ParagraphFormat.Alignment = wdAlignParagraphCenter '水平居中
                End If
            End If
        End With
    Next
End Sub

如果文档中有很多表格，每个表格都要这样处理，那么可以在For Each aCell In ActiveDocument.Tables(1).Range.Cells外层再套一个遍历文档全部表格的for循环，类似于：

'...

For Each aTable In ActiveDocument.Tables
    For Each aCell In aTable.Range.Cells

'...

补充一个代码运行时的录屏如下，可见原来左对齐的一行内容的单元格变成了居中对齐，原来居中对齐的2个段落的单元格以及一个多行段落的单元格全部由居中对齐变成了左对齐：