Need enhanced table to text conversion

[Walter Briscoe]

I use Word 2003.
I have a document which consist of a sequence of tables separated by
page breaks.
I can convert the document to text by putting the focus in each table in
turn and doing Table/Convert/Table to Text/Paragraph Marks/OK.
That is tedious in a 50 table document.
I would appreciate advice on some VBA to automate the process.

Each table consists of a full width row followed by two rows of 4
columns.

I hope this explains the layout
wwwwwww1
h1h2h3h4
t1t2t3t4

This is converted to
wwwwwww1
h1
h2
h3
h4
t1
t2
t3
t4

(It runs across rows first and then down columns)

I want it to convert to
wwwwwww1
h1
t1
h2
t2
h3
t3
h4
t4
(I want it to run down columns first and than across rows.)

While I could shuffle the output, it is tedious and error-prone.
I would value advice on simplifying the process.

 

[DeanH]

If you are not worried about formatting, then you can select all of the
tables (Ctrl+A) or cursor before the first table and Ctrl+Shft+End, copy and
then you can use Paste Special, Unformatted Text, which will give you no
tables but text Tab Delimited.
Hope this helps
DeanH

 

[Walter Briscoe]

In message <[email protected]> of Fri,
5 Jun 2009 05:30:02 in microsoft.public.word.tables, DeanH

That is certainly a fast way to eliminate the tables. It suffers the
same problem I had of re-ordering the text.

 

[Doug Robbins - Word MVP]

Use a macro containing the following code:

Dim i As Long, m As Long, n As Long
Dim crange As Range, target As Range
With ActiveDocument
For i = 1 To .Tables.Count
With .Tables(i)
Set target = .Range.Duplicate
target.Collapse wdCollapseEnd
Set crange = .Cell(1, 1).Range
crange.End = crange.End - 1
target.Text = crange.Text
For m = 1 To .Columns.Count
For n = 2 To .Rows.Count
Set crange = .Cell(n, m).Range
crange.End = crange.End - 1
target.Text = target.Text & vbCr & crange.Text
Next n
Next m
.Delete
End With
Next i
End With



--
Hope this helps.

Please reply to the newsgroup unless you wish to avail yourself of my
services on a paid consulting basis.

Doug Robbins - Word MVP, originally posted via msnews.microsoft.com

 

[Walter Briscoe]

In message <[email protected]> of Sat, 6 Jun 2009
21:11:17 in microsoft.public.word.tables, Doug Robbins - Word MVP

That is the sort of thing I had in mind. I start with 39 tables. It
converts the first and then fails , but leaves me with 28! It then
converts the second and fails. It then does nothing more. I am not sure
the logic is correct. The first through the loop works on Tables(1) and
the number of tables is reduced by 1. The next time, Tables(2) used to
be Tables(3), etc. I tried For i= Tables.Count to 1, but that also
failed 5941 The requested member of the collection does not exist in Set
crange = .Cell(1, 1).Range.
My suspicion is that the data is not quite what I think.

Before seeing your work, I tried:
For Each atable In ActiveDocument.Tables
If atable.Columns.Count = 4 Then
For i = 1 To 4
Selection.MoveRight Unit:=wdCell
Selection.MoveDown Unit:=wdLine, Extend:=wdExtend
Selection.Cells.Merge
Next i
End If
Next atable

That did not seem to move onto the second table.

 

[Doug Robbins - Word MVP]

I should have realised that would happen as when the table is deleted, the
number of tables in the document changes (I developed the code working on a
document that contained just one table. The following code starts with the
last table in the document and works towards the first and will overcome
that problem:

Dim i As Long, m As Long, n As Long
Dim crange As Range, target As Range
With ActiveDocument
For i = .Tables.Count To 1 Step - 1
With .Tables(i)
Set target = .Range.Duplicate
target.Collapse wdCollapseEnd
Set crange = .Cell(1, 1).Range
crange.End = crange.End - 1
target.Text = crange.Text
For m = 1 To .Columns.Count
For n = 2 To .Rows.Count
Set crange = .Cell(n, m).Range
crange.End = crange.End - 1
target.Text = target.Text & vbCr & crange.Text
Next n
Next m
.Delete
End With
Next i
End With


--
Hope this helps.

Please reply to the newsgroup unless you wish to avail yourself of my
services on a paid consulting basis.

Doug Robbins - Word MVP, originally posted via msnews.microsoft.com

 

[Walter Briscoe]

In message <[email protected]> of Sun, 7 Jun 2009
08:56:49 in microsoft.public.word.tables, Doug Robbins - Word MVP

Thanks, again, for your efforts.
When I ran the code, it hit something like "no such object" at "Set
crange = .Cell(1, 1).Range". I realised the data did not quite fit the
model. I threw together this code to show each table in turn:

With ActiveDocument
For i = 1 To .Tables.Count
.Tables(i).Select
MsgBox "Selected table " & i ' Could not find 2 sec wait code!
Next i
End With

That showed I had a couple of tables which had more than one set of data
in them. I split those tables and things went better.
I tidied up page breaks - the original document was inconsistent in use
of page and section breaks. I found I could find section breaks, but not
replace them. I did not bother to construct a loop of find section
break, delete, insert page break but did that by hand. At the end, I
wished I had written a macro to do so.

One thing that is lost in the data is font information. e.g. Some Arial,
48 point, centered data becomes Arial 12 point, left-justified

Thanks, yet again, for your valuable help.

 

[Walter Briscoe]

In message <[email protected]> of Mon, 8 Jun 2009
07:47:53 in microsoft.public.word.tables, Walter Briscoe

In message <[email protected]> of Sun, 7 Jun 2009
08:56:49 in microsoft.public.word.tables, Doug Robbins - Word MVP

Thanks, again, for your efforts.
When I ran the code, it hit something like "no such object" at "Set
crange = .Cell(1, 1).Range". I realised the data did not quite fit the
model. I threw together this code to show each table in turn:

More than a year later, I found myself with similar data.
I did some development.

This is code to transform tables to text in column order:
Sub DeTable()
'
' Replace tables consisting of r1c1, r1c2, ... rncn by paragraph array r1c1, r2c1, ... rncn
' i.e. Do table to text by columns
'
Dim i As Long, m As Long, n As Long
Dim target As Range

With ActiveDocument
For i = .Tables.Count To 1 Step -1 ' Reverse loop so deleting tables does not renumber
With .Tables(i)
Set target = .Range.Duplicate ' Take copy of properties
target.Collapse wdCollapseEnd ' Empty target - font, etc taken from following character
For m = 1 To .columns.Count
For n = 1 To .rows.Count
target.Text = target.Text & .Cell(n, m).Range.Text
Next n
Next m
target.End = target.End - 1 ' Strip last character
.Delete
End With
Next i
End With
End Sub

I also constructed code to invert the operation if each table cell
consists of one paragraph. The code is probably naive and I would
appreciate thoughts to improve it:
Private Function ParagraphItemToText(ByVal item As Variant) As String
Dim c As Variant
Dim i As Long
Dim s As String

Set c = item.Range.Characters
For i = 1 To c.Count
s = s & c.item(i).Text
Next i
ParagraphItemToText = s
End Function

Sub Entable()
' Re-order an array output by DeTable so it can be converted back to a table
'
Dim cells As Long
Dim columns As Long
Dim rows As Long
Dim s As Selection
Dim t As String
Dim output As Range
Dim i As Long, j As Long

Set s = Selection
If Not s.Type = wdSelectionNormal _
Then Err.Raise 3142, , "Select a line array"
cells = s.Paragraphs.Count
columns = InputBox("Table Columns for selection", _
"Invert linear table", 2)
If Not cells Mod columns = 0 _
Then Err.Raise 3142, , "Paragraphs(" & cells & _
") is not a multiple of columns(" & columns & ")"
rows = cells / columns
Set output = s.Range.Duplicate ' Take copy of properties
output.Collapse wdCollapseEnd ' Empty target - font, etc taken from following character

For j = 1 To rows
For i = j To cells Step rows
output.Text = output.Text & _
ParagraphItemToText(s.Paragraphs.item(i))
Next i
Next j
output.End = output.End - 1 ' Strip last character
s.Delete
End Sub