(no subject)

Dec 17, 2006 20:00

Ура, заработало!
Спасибо всем за моральную и физическую поддержку.

кому интересно - текст макроса под катом



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

Но и гадость же эта ваша заливная рыба, в смысле интерфейс у ворд бейсика жутко неудобный...

vb, programming, word, macro

Previous post Next post
Up