How to arrange the tables so that...?

[cyberdude]

Hi,

I have 10 tables arranged like this:

table 1

table 2

..
..
..

table10

Each table is a simple 1 row x 1 column table. Two nearest tables are
separated by an empty line. I would like to write a macro that re-
arranges the table like this:

table 1

table 3

..
..
..

table 9

table 2

table 4

..
..
..

table10.

After the re-arrangement, the odd-number-tables are in the first part
of the document, and they are followed by the even-number-tables.
This is my first problem.

The second problem is that I need to remove the table frames after the
re-arrangement. In other words, I want to take the content out of
each table, remove the table frame and put the content back to its
original position.

Mike

 

[StevenM]

Cyberdude,

I'm not for sure I understood what you meant by "put the content back to its
original position."

I wrote the macro so that it produces a new document with the changes.
If you like, we can work on modifying it to get it to what you want, or
perhaps you can figure everything else from here.

Sub SortTablesOddEven()
Dim actDoc As Document
Dim newDoc As Document
Dim oRange As Range
Dim numOfTables As Long
Dim nTable As Long

Set actDoc = ActiveDocument
Set newDoc = Documents.Add
Set oRange = newDoc.Range
'
' Copy all odd numbered tables to new document
'

numOfTables = actDoc.Tables.Count
For nTable = 1 To numOfTables Step 2
actDoc.Tables(nTable).Range.Copy
With oRange
.Paste
.InsertParagraphAfter
.Collapse wdCollapseEnd
End With
Next nTable
'
' Copy all even numbered tables to new document
'
If numOfTables > 1 Then
For nTable = 2 To numOfTables Step 2
actDoc.Tables(nTable).Range.Copy
With oRange
.Paste
.InsertParagraphAfter
.Collapse wdCollapseEnd
End With
Next nTable
End If
'
' Change all tables in new document to text
'
numOfTables = newDoc.Tables.Count
Set oRange = newDoc.Range
For nTable = numOfTables To 1 Step -1
With oRange.Tables(nTable)
.ConvertToText Chr(13)
End With
Next nTable
End Sub

Steven Craig Miller

 

[cyberdude]

Cyberdude,

I'm not for sure I understood what you meant by "put the content back to its
original position."

I wrote the macro so that it produces a new document with the changes.
If you like, we can work on modifying it to get it to what you want, or
perhaps you can figure everything else from here.

Sub SortTablesOddEven()
Dim actDoc As Document
Dim newDoc As Document
Dim oRange As Range
Dim numOfTables As Long
Dim nTable As Long

Set actDoc = ActiveDocument
Set newDoc = Documents.Add
Set oRange = newDoc.Range
'
' Copy all odd numbered tables to new document
'

numOfTables = actDoc.Tables.Count
For nTable = 1 To numOfTables Step 2
actDoc.Tables(nTable).Range.Copy
With oRange
.Paste
.InsertParagraphAfter
.Collapse wdCollapseEnd
End With
Next nTable
'
' Copy all even numbered tables to new document
'
If numOfTables > 1 Then
For nTable = 2 To numOfTables Step 2
actDoc.Tables(nTable).Range.Copy
With oRange
.Paste
.InsertParagraphAfter
.Collapse wdCollapseEnd
End With
Next nTable
End If
'
' Change all tables in new document to text
'
numOfTables = newDoc.Tables.Count
Set oRange = newDoc.Range
For nTable = numOfTables To 1 Step -1
With oRange.Tables(nTable)
.ConvertToText Chr(13)
End With
Next nTable
End Sub

Steven Craig Miller

Hi Steven,

Thank you very much for your reply.

The code works very well. But I want to make one modification.

After the execution, table 1 and table 3 are separated by one line but
the remaining tables are joined together. For example, table 3 and
table 5 are connected and so are table 5 and table 7. If I want to
make two nearest tables be separated by a line of empty space, what
should I do? Thanks.

Mike

 

[StevenM]

To: Cyberdude,

<< After the execution, table 1 and table 3 are separated by one line but
the remaining tables are joined together. For example, table 3 and table 5
are connected and so are table 5 and table 7. If I want to make two nearest
tables be separated by a line of empty space, what should I do? >>

When I ran the code on my mock-up test document, it appeared to work
correctly, but when I stepped through the code line by line, I discovered the
problem just as you described it. Sorry about that, this should correct the
problem. If you would like any futher modifications, just ask.

Sub SortTablesOddEven()
Dim actDoc As Document
Dim newDoc As Document
Dim oRange As Range
Dim numOfTables As Long
Dim nTable As Long

Set actDoc = ActiveDocument
Set newDoc = Documents.Add
Set oRange = newDoc.Range
'
' Copy all odd numbered tables to new document
'

numOfTables = actDoc.Tables.Count
For nTable = 1 To numOfTables Step 2
actDoc.Tables(nTable).Range.Copy
With oRange
.Paste
.Collapse wdCollapseEnd
.InsertParagraphAfter
.Collapse wdCollapseEnd
End With
Next nTable
'
' Copy all even numbered tables to new document
'
If numOfTables > 1 Then
For nTable = 2 To numOfTables Step 2
actDoc.Tables(nTable).Range.Copy
With oRange
.Paste
.Collapse wdCollapseEnd
.InsertParagraphAfter
.Collapse wdCollapseEnd
End With
Next nTable
End If
'
' Change all tables in new document to text
'
numOfTables = newDoc.Tables.Count
Set oRange = newDoc.Range
For nTable = numOfTables To 1 Step -1
With oRange.Tables(nTable)
.ConvertToText Chr(13)
End With
Next nTable
End Sub


Steven Craig Miller