vba - 防止垂直合并的单元格跨页破坏 - 自动

Question

我必须创建包含从 Excel 复制到其中的大型数据表的文档。这些表可能有数百行长，通常约为 20 列宽。许多列已垂直合并，以增强可读性并对数据集进行分组。

我已经能够编写一个宏来完全格式化整个表格，但我无法弄清楚如何自动防止垂直合并单元格跨多个页面断开/拆分。要手动执行此操作，您可以选择合并中除最后一行之外的所有行，然后在段落设置中打开“与下一行保持一致”。我认为这很容易做到，但如果表中存在任何垂直合并的单元格，则无法访问 VBA 中的各个行。

有人知道如何自动遍历行并为已合并在一起的行组设置“与下一个保持一致”属性吗？

下面是 Word 通常如何处理跨表格垂直合并单元格的示例:

这就是我希望的样子，手动完成所有工作:

Answer 1

是的，在 Word(以及 Excel)中处理合并单元格非常烦人。

不过，这可以通过访问表中的各个单元格来完成。我在下面编写了以下子例程，应该对您有用。我假设您至少有一列没有垂直合并的单元格，并且只有一列控制合并 block 的长度。尽管添加更多控制列应该很容易。

Sub MergedWithNext() 'FTable As Table)

Dim Tester As String
Dim FTable As Table
Dim i As Integer
Dim imax As Integer
Dim RowStart As Integer
Dim RowEnd As Integer
Dim CNMerged As Integer
Dim CNNotMerged As Integer
Dim CNMax As Integer

CNMerged = 2 'A column number that is vertically merged that you don't want to split pages
CNNotMerged = 1 'A column number that has no vertical mergers

Set FTable = Selection.Tables(1)

With FTable
imax = .Rows.Count
CNMax = .Columns.Count

'Start with no rows kept with next
ActiveDocument.Range(Start:=.Cell(1, 1).Range.Start, _
    End:=.Cell(imax, CNMax).Range.End).ParagraphFormat.KeepWithNext = False

On Error Resume Next
For i = 2 To imax 'Assume table has header

    Tester = .Cell(i, CNMerged).Range.Text 'Test to see if cell exists
    If Err.Number = 0 Then 'Only the first row in the merged cell will exist, others will not

        'If you are back in this If statement, then you have left the previous block of rows
        'even if that was a block of one. The next If statement checks to see if the previous
        'row block had more than one row. If so it applies the "KeepWithNext" property

        If (RowEnd = (i - 1)) Then

            '.Cell(RowStart, 1).Range.ParagraphFormat.KeepWithNext = True
            ActiveDocument.Range(Start:=.Cell(RowStart, CNNotMerged).Range.Start, _
                End:=.Cell(RowEnd - 1, CNNotMerged).Range.End).ParagraphFormat.KeepWithNext = True

                'Use RowEnd - 1 because you don't care if the whole merged block stays with the next
                'row that is not part of the merger block

        End If

        RowStart = i 'Beginning of a possible merger block
        RowEnd = 0 'Reset to 0, not really needed, used for clarity

    Else

        RowEnd = i 'This variable will be used to determine the last merged row
        Err.Clear

    End If

    If i = imax Then 'Last Row

        If (RowStart <> imax) Then

            ActiveDocument.Range(Start:=.Cell(RowStart, CNNotMerged).Range.Start, _
                End:=.Cell(imax - 1, CNNotMerged).Range.End).ParagraphFormat.KeepWithNext = True

                'Use imax - 1 because you don't care if the whole merged block stays with the next
                'row that is not part of the merger block

        End If

    End If

Next i
On Error GoTo 0
End With
End Sub

此代码将循环遍历表中的每一行(不包括标题)，查找垂直合并的单元格。一旦找到一个 block ，它就会将“Keep With Next”属性分配给该 block 中的每一行(最后一行除外)。