View Single Post
  #8  
Old October 26th, 2006, 02:56 AM posted to microsoft.public.word.tables
Tesla
external usenet poster
 
Posts: 8
Default The tables are turned! Well... not yet.

Yes, there is. It involves a small macro that the vendor does not ship with
the product. I am sorry that this forum danced around the issue and gave you
no good advice.

This is a complete solution, which handles multiple tables selected, of any
size, even with embedded OLE objects in the cells, and keeps the original
formatting of the table. I worked Equations objects successfully in them.

Do not panic with the seemingly chaotic dance of tables and selections in
the document during processing, it all works nicely.

Here it is:
Option Explicit
' Author: Sidney, like I need to give a last name!
Sub TransposeTablesSelected()
Dim t As Table
For Each t In Selection.Tables
TransposeTable t
Next
End Sub
Sub TransposeTable(t As Table)
Dim original_rows As Integer
original_rows = t.Rows.Count

Dim original_cols As Integer
original_cols = t.Columns.Count

Dim diagonal_count As Integer
diagonal_count = IIf(original_rows original_cols, original_rows,
original_cols)

' increase size
Do While t.Rows.Count diagonal_count
t.Rows.Add
Loop
Do While t.Columns.Count diagonal_count
t.Columns.Add
Loop

' Auxiliary holder of table cell
Selection.MoveUp Unit:=wdLine, Count:=1
Dim auxTable As Table
Set auxTable = ActiveDocument.Tables.Add(Range:=Selection.Range,
NumRows:=2, NumColumns:= _
2, DefaultTableBehavior:=wdWord9TableBehavior, AutoFitBehavior:= _
wdAutoFitContent)

Dim j As Integer
Dim k As Integer
For k = 1 To diagonal_count
For j = k + 1 To diagonal_count
Call TableCellSwap(t, k, j, auxTable, j, k)
Next
Next

auxTable.Delete

' decrease size
Do While t.Rows.Count original_cols
t.Rows(t.Rows.Count).Delete
Loop
Do While t.Columns.Count original_rows
t.Columns(t.Columns.Count).Delete
Loop
End Sub
Sub TableCellMove(sourceTable As Table, sourceRow As Integer, sourceCol As
Integer, destTable As Table, destRow As Integer, destCol As Integer)
sourceTable.Cell(sourceRow, sourceCol).Select
Selection.Cut

destTable.Cell(destRow, destCol).Select
Selection.Paste
End Sub
Sub TableCellSwap(sourceTable As Table, sourceRow As Integer, sourceCol As
Integer, auxTable As Table, destRow As Integer, destCol As Integer)
Call TableCellMove(sourceTable, destRow, destCol, auxTable, 1, 1)
Call TableCellMove(sourceTable, sourceRow, sourceCol, sourceTable,
destRow, destCol)
Call TableCellMove(auxTable, 1, 1, sourceTable, sourceRow, sourceCol)
End Sub


"Cooz" wrote:

Hi everyone,

Is there a way to turn a Word table so that its columns become rows and its
rows become columns? If yes... how?

Thank you,
Cooz