View Single Post
 
Old 07-19-2020, 07:09 PM
Guessed's Avatar
Guessed Guessed is offline Windows 10 Office 2016
Expert
 
Join Date: Mar 2010
Location: Canberra/Melbourne Australia
Posts: 4,176
Guessed has a brilliant futureGuessed has a brilliant futureGuessed has a brilliant futureGuessed has a brilliant futureGuessed has a brilliant futureGuessed has a brilliant futureGuessed has a brilliant futureGuessed has a brilliant futureGuessed has a brilliant futureGuessed has a brilliant futureGuessed has a brilliant future
Default

Nice work Greg. I was hoping you could find a way of avoiding Selection though

The code I posted failed because of three factors I see in your posted example:
1. Nested tables were ignored
1a. Nested tables 'selection below' is still inside a table
2. Inconsistent row lengths
3. Spans across page breaks

Greg's code has solved most of these but the 1a issue causes the last row in the nested table to get ignored. We can avoid Greg's error handling workaround if we include another If statement to test for shorter row lengths and also change the method to determine whether moving selection down is still inside the table under review.
Code:
Sub Tables2Levels()
  Dim aTbl As Table, aTblinner As Table
  Dim lngView As Long
  lngView = ActiveDocument.ActiveWindow.View
  ActiveDocument.ActiveWindow.View = wdNormalView
  For Each aTbl In ActiveDocument.Tables
    SplitVertMergeCells aTbl
    For Each aTblinner In aTbl.Tables 'process the first level nested tables as well
      SplitVertMergeCells aTblinner
    Next aTblinner
  Next aTbl
  ActiveDocument.ActiveWindow.View = lngView
End Sub

Sub SplitVertMergeCells(aTbl As Table)
  Dim aCell As Cell, i As Integer, aRng As Range
  Dim iRow As Integer, iCol As Integer, iSplit As Integer
  If Not aTbl.Uniform Then
    For Each aCell In aTbl.Range.Cells
      If aCell.RowIndex = aTbl.Rows.Count Then Exit For
      Set aRng = aCell.Range
      aRng.Select
      Selection.MoveDown Unit:=wdLine, Count:=1
      If Selection.Range.End < aTbl.Range.End Then
        If Selection.Information(wdAtEndOfRowMarker) Then 'table has inconsistent row lengths
          iSplit = 1
        Else
          iSplit = Selection.Cells(1).RowIndex - aRng.Cells(1).RowIndex
        End If
      Else
        iSplit = aTbl.Rows.Count - aRng.Cells(1).RowIndex + 1
      End If
      If iSplit > 1 Then aCell.Split NumRows:=iSplit
    Next aCell
  End If
End Sub
__________________
Andrew Lockton
Chrysalis Design, Melbourne Australia
Reply With Quote