Hello SH,
10. mája 2002, 12:02:19, si napisal:
S> Pomuzete mi prosim nekdo s nasledujicim resenim?
S> Po vytvoreni dopisu hromadne korespondence
S> vytvorim novy soubor s jednotlivymi dopisy na strance,
S> kde co stranka to jiny prijemce.
S> Existuje zpusob jak kazdou jednotlivou stranku
S> tohoto souboru ulozim jako jednotlivy soubor?
S> Dekuji za pripadnou radu.
S> Slavek
Treba spustit nasledovne makro:
'START CUT ==========================
Sub SaveRecsAsFiles
' Convert all sections to Subdocs
AllSectionsToSubDoc ActiveDocument
'Save each Subdoc as a separate file
SaveAllSubDocs ActiveDocument
End Sub
Sub AllSectionsToSubDoc(ByRef doc As Word.Document)
Dim secCounter As Long
Dim NrSecs As Long
NrSecs = doc.Sections.Count
'Start from the end because creating
'Subdocs inserts additional sections
For secCounter = NrSecs - 1 To 1 Step -1
doc.Subdocuments.AddFromRange _
doc.Sections(secCounter).Range
Next secCounter
End Sub
Sub SaveAllSubDocs(ByRef doc As Word.Document)
Dim subdoc As Word.Subdocument
Dim newdoc As Word.Document
Dim docCounter As Long
docCounter = 1
'Must be in MasterView to work with
'Subdocs as separate files
doc.ActiveWindow.View = wdMasterView
For Each subdoc In doc.Subdocuments
Set newdoc = subdoc.Open
'Remove NextPage section breaks
'originating from mailmerge
RemoveAllSectionBreaks newdoc
With newdoc
.SaveAs FileName:="MergeResult" & CStr(docCounter)
.Close
End With
docCounter = docCounter + 1
Next subdoc
End Sub
Sub RemoveAllSectionBreaks(doc As Word.Document)
With doc.Range.Find
.ClearFormatting
.Text = "^b"
With .Replacement
.ClearFormatting
.Text = ""
End With
.Execute Replace:=wdReplaceAll
End With
End Sub
'END CUT ==========================
Toto makro predpoklada ze prvy odstavec "master" dokumentu je
formatovany ako level1. Po vytvoreni zluceneho dopisu, treba spustit
toto makro.
--
Zdravi,
Jani
mailto:JBystriansky@seznam.cz
This archive was generated by hypermail 2.1.2 : 10. 05. 2002, 15:30 CEST