Writer – Fusionne tous les documents writer dans un document unique

Auteur : Laurent Godard

Révision : 01b – correction premiere page en double

Amélioration : A venir

Permet de fusionner entre autres des documents issus d'un publipostage et générés en tant que fichier

Regroupe alors le N documents générés par OpenOffice.org

Cree le fichier ResultatFusion.sxw dans le repertoire concerné

Note 1 : Faire un copier/coller sur l’ensemble.

Sub FusionneDocument()

on error resume next

'demande repertoire

Repertoire=GetFolderName()

if trim(repertoire)="" then

msgbox "Abandon",16,"Fusion de documents"

exit sub

endif

if right(repertoire,1)<>"/" then

repertoire=repertoire+"/"

endif

fichier=dir(repertoire)

if fichier<>"" then

filecopy ConvertToURL(repertoire+fichier),ConvertToURL(repertoire+"ResultatFusion.sxw")

fichier=dir()

endif

'Inverser le commentaires de ces lignes si on veut le processus muet

dim args()

'dim args(0) as new com.sun.star.beans.PropertyValue

'args(0).name="Hidden"

'args(0).value=true

'ouverture du document de synthese

odesktop=CreateUnoService("com.sun.star.frame.Desktop")

surl=ConvertToURL(repertoire+"ResultatFusion.sxw")

odocument=odesktop.Loadcomponentfromurl(surl,"_blank",0,Args())

oText = oDocument.getText

oCursor = oText.createTextCursor()

'Boucle sur les docs du reprtoire

dim argsInsert()

while fichier<>""

if lcase(right(fichier,3))="sxw" then

oCursor.gotoEnd(false)

oCursor.BreakType = com.sun.star.style.BreakType.PAGE_BEFORE

oCursor.insertDocumentFromUrl(ConvertToURL(repertoire+fichier),insertProps)

endif

fichier=dir()

wend

'fermeture document

dim args2()

odocument.StoreAsURL(repertoire+"ResultatFusion.sxw",args2())

odocument.dispose

'recharge pour montrer

surl=repertoire+"ResultatFusion.sxw"

odocument=odesktop.Loadcomponentfromurl(surl,"_blank",0,Args2())

end sub

'********************

Function GetFolderName() as string

Dim oFolderDialog as Object

Dim iAccept as Integer

Dim sPath as String

Dim InitPath as String

Dim RefControlName as String

Dim oUcb as object

'Note: The following services have to be called in the following order

' because otherwise Basic does not remove the FileDialog Service

oFolderDialog = CreateUnoService("com.sun.star.ui.dialogs.FolderPicker")

oUcb = createUnoService("com.sun.star.ucb.SimpleFileAccess")

iAccept = oFolderDialog.Execute()

If iAccept = 1 Then

sPath = oFolderDialog.GetDirectory()

If oUcb.Exists(sPath) Then

sPath = ConvertFromUrl(sPath)

End If

End If

GetFolderName=ConvertToURL(spath)

End function

Laurent Godard

2003-05-04T09:01:58