Re: [users-fr] =?windows-1252?Q?possibilit=E9_de_cr=E9ation_?= =?windows-1252?Q?d=27un_seul_fichier_par_mailling_sans_saut_?= =?windows-1252?Q?de_page?=

[Francois Gatto (xhydrogene)]

Bonjour Fabienne,
jmi_ooo a écrit :
Et personnellement, je n'ai jamais écrit de macro et
même rarement utilisé. Je pense effectivement qu'il
n'est peut être pas compliqué de la modifier mais ne
serait pas en mesure de le faire.
J'ai lu avec intérêt vos messages et espère vous apporter ici une solution.
J'ai simplement adapté quelque peu la macro de fusion de Laurent Godard 
en tenant compte de vos remarques.

Même avec des étiquettes, mon résultat de fusion reste
en non modifiable, grisé. Il n'existe pas de moyen
pour modifier directement ce type de texte sans aller
changer le fichier qui sert de base de données ?
La nouvelle macro propose en fin de traitement la conversion des champs 
en textes non formatés. En répondant par Oui vous obtiendrez un document 
listant toutes les données qui ne seront donc plus grisées et donc 
modifiables.

Merci encore,
Espérant avoir répondu au mieux à vos attentes.
Fabienne
François Gatto
=^..^=
Voici le code adapté ; il vous suffit de le recopier et de le placer 
dans un nouveau module de la bibliothèque Standard de l'application soffice.

Sub FusionneDocument()
' Code source Laurent Godard
' adpaté par François Gatto
'
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)
			'activer la ligne ci-dessous pour insérer un saut de page
			'oCursor.BreakType = com.sun.star.style.BreakType.PAGE_BEFORE
			'désactiver la ligne ci-dessous pour ne pas supprimer les sauts de page
			'à utiliser pour avoir une liste
			oCursor.BreakType = com.sun.star.style.BreakType.NONE		
		 
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())
	'demande de convertion des champs en texte non formaté
	rep = MsgBox("Convertir les champs en texte",36,"Convertion des champs")
	if rep = 6 then 'si rep = Oui on convertit les champs
		FieldToText
	endif
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
'***********************
sub FieldToText
' procédure de conversion des champs d'un document
' en textes non formatés
'
dim document   as object
dim dispatcher as object
document   = ThisComponent.CurrentController.Frame
dispatcher = createUnoService("com.sun.star.frame.DispatchHelper")
dispatcher.executeDispatch(document, ".uno:SelectAll", "", 0, Array())
dispatcher.executeDispatch(document, ".uno:Cut", "", 0, Array())
dim args3(0) as new com.sun.star.beans.PropertyValue
args3(0).Name = "SelectedFormat"
args3(0).Value = 1
dispatcher.executeDispatch(document, ".uno:ClipboardFormatItems", "", 0, 
args3())
end sub

---------------------------------------------------------------------
To unsubscribe, e-mail: [EMAIL PROTECTED]
For additional commands, e-mail: [EMAIL PROTECTED]