Ура, заработало!
Спасибо всем за моральную и физическую поддержку.
кому интересно - текст макроса под катом
Sub convert()
'
Dim mystring As String
' select table and move to the new document to make sure what we want to export
Selection.Tables(1).Select
Selection.Copy
Documents.Add DocumentType:=wdNewBlankDocument
Selection.PasteAndFormat (wdPasteDefault)
Dim myindex As Integer
Dim mydocrange As Range
Dim newrange As Range
Dim newdoc As Document
Dim myheaderrow As Row
Dim mytable As Table
Dim filename As String
Set mytable = ActiveDocument.Tables(1)
Set myheaderrow = mytable.Rows(1)
For Each aRow In mytable.Rows
Set myCell = aRow.Cells(1)
Set newdoc = Documents.Add
Set mydocrange = newdoc.Range(Start:=0, End:=0)
Dim i As Integer
If aRow.Index <> 1 Then ' we dont want to save headers
For Each aCell In aRow.Cells
aCell.Select
Selection.Copy
With mydocrange
.Paste
.Collapse Direction:=wdCollapseEnd
.InsertParagraphAfter
.Collapse Direction:=wdCollapseEnd
End With
' add some info from headers
i = aCell.ColumnIndex
myheaderrow.Cells(i).Select
Selection.Copy
With mydocrange
.Paste
.Collapse Direction:=wdCollapseEnd
.InsertParagraphAfter
.Collapse Direction:=wdCollapseEnd
End With
Next aCell
' newfiletext = newfiletext + "*/"
Set newrange = newdoc.Words(1)
With newdoc
filename = newrange.Text
For Each aTable In newdoc.Tables
For Each aCell In aTable.Range.Cells
aCell.Range.InsertBefore "/*"
aCell.Range.InsertAfter "*/"
Next aCell
Next aTable
.SaveAs filename:=filename, FileFormat:=wdFormatText, _
LockComments:=False, Password:="", AddToRecentFiles:=True, WritePassword _
:="", ReadOnlyRecommended:=False, EmbedTrueTypeFonts:=False, _
SaveNativePictureFormat:=False, SaveFormsData:=False, SaveAsAOCELetter:= _
False, Encoding:=1251, InsertLineBreaks:=False, AllowSubstitutions:=False _
, LineEnding:=wdCRLF
MsgBox (filename)
End With
' Else
' newdoc.Close
End If
' here we should save the file
Next aRow
End Sub
Но и гадость же эта ваша заливная рыба, в смысле интерфейс у ворд бейсика жутко неудобный...