View Single Post
 
Old 07-17-2020, 10:07 AM
gmaxey gmaxey is offline Windows 10 Office 2016
Expert
 
Join Date: May 2010
Location: Brasstown, NC
Posts: 1,427
gmaxey is a jewel in the roughgmaxey is a jewel in the roughgmaxey is a jewel in the roughgmaxey is a jewel in the rough
Default

T-Belle

This mod of Andrews code will come close with your attached. However, the merges cells that span a page aren't split.


Code:
Sub ProcTbls()
Dim oTbl As Table, oNT As Table
  For Each oTbl In ActiveDocument.Tables
    SplitVMCs oTbl
    For Each oNT In oTbl.Tables
      SplitVMCs oNT
    Next oNT
  Next oTbl
lbl_Exit:
  Exit Sub
End Sub

Sub SplitVMCs(oTbl As Table)
Dim oCell As Cell, oRng As Range
Dim lngRow As Long, lngSplit As Long
  If Not oTbl.Uniform Then
    For Each oCell In oTbl.Range.Cells
    If oCell.RowIndex = oTbl.Rows.Count Then Exit For
      Set oRng = oCell.Range
      oRng.Select
      Selection.MoveDown Unit:=wdLine, Count:=1
      On Error GoTo Err_Cell
      If Selection.Information(wdWithInTable) Then
        lngSplit = Selection.Cells(1).RowIndex - oRng.Cells(1).RowIndex
      Else
        lngSplit = oTbl.Rows.Count - oRng.Cells(1).RowIndex + 1
      End If
Err_RE:
      If lngSplit > 1 Then oCell.Split NumRows:=lngSplit
    Next oCell
  End If
lbl_Exit:
  Exit Sub
Err_Cell:
  lngSplit = 1
  Resume Err_RE
End Sub
__________________
Greg Maxey
Please visit my web site at http://www.gregmaxey.com/
Reply With Quote