Word table remove text from cells preserving format

[StuckInTheMiddle]

Does anyone know if its possible to copy the text out of a word table so that each cell becomes plain text without the table formatting?

I know about "table/convert table to text option" and this is not satisfactory because if a cell has a long text in it the formatting gets all screwed.

For example my word table could look like this
[tt]
-----------------------
|1 |22222 |3 |
| |2222 | |
-----------------------
|4 |5 |6 |
-----------------------
|7 |8 |9 |
-----------------------
[/tt]
and everything I have attempted makes it look like this without the table formatting
[tt]
1 22222 2222 [highlight]3[/highlight]
4 5 6
7 8 9
[/tt]
You see that the 3 is pushed out, ideally I want this to be
[tt]
1 22222 3
[highlight]2222[/highlight]
4 5 6
7 8 9
[/tt]
With the long text stretching onto a new line, without effecting the layout of the text in the cell.

Any ideas appreciated,

 

[Dreamboat]

You can't wrap text in a column that's delimited by a character. You can only text wrap in a table.

If you ask me, this is simply a matter of converting table to text, and then formatting the tabs to be spaced farther apart.

Anne Troy

http://www.vbaexpress.com/forum

 

[StuckInTheMiddle]

Thanks, I am all too aware that the text does not get automatically wrapped. I want to VBA code the solution, here is my best attempt thus far, minus the declarations.

This takes each cell in a table and pastes it to plain text, keeping the format intact. Of course you will see that it doesnt wrap text yet. I;m hoping a VBA programmer can help me out.

[tt]
'For each table, create its text equivalent
For intTableNumber = 1 To intTableCount
Set tabTable = ThisDocument.Tables(intTableNumber)

For lngX = 1 To tabTable.Rows.Count
For lngY = 1 To tabTable.Columns.Count
ThisDocument.Tables(intTableNumber).Cell(lngX, lngY).Select
Selection.MoveLeft Unit:=wdCharacter, Count:=1, Extend:=wdExtend
Selection.Copy
intSpacesTotal = intCharsPerCell - (Selection.End - Selection.Start)
'Goto end of table, this is where we are going to insert tables values
ThisDocument.Tables(intTableNumber).Cell(ThisDocument.Tables(intTableNumber).Rows.Count, ThisDocument.Tables(intTableNumber).Columns.Count).Select
Selection.MoveDown Unit:=wdLine, Count:=lngX

'Paste our cells value, it comes with it's original formatting
Selection.Paste
'Turn off any formatting for the spaces we are about to insert (needed to get the text to line up, this assumes monospaced font)
Selection.Font.Bold = False
Selection.Font.Italic = False
Selection.Font.Underline = wdUnderlineNone

For intSpacesNumber = 1 To intSpacesTotal
Selection.TypeText Text:=" "
Next
Next lngY

Selection.TypeText Text:=vbCr
Next lngX
Next intTableNumber
[/tt]