I'm trying to do a kind of catalogue with texts and pictures on the fly. Each page shows one picture. My database is a Calc spreadheet. Everything works fine when tested without images, but otherwise crashes with a runtime error when reaching page 23.
I'm using a customized code found on a french OOo forum :
Code: Select all
option explicit
global PysDlg as object, PysConnexion as object
Sub PysLancerPublipostage
dim PysLettreType as object, PysNewDoc as object, PysTexte as object, PysCurseur as object
dim PysForm as object, PysCtrlImg as object, PysTables as object
dim PysRowSet as object, PysEnum as object, PysChamp as object, PysRange as object
dim URL as string, EXT as string
dim PysProp(0) as new com.sun.star.beans.PropertyValue
dim PysUrl as string
dim PysNbForms as integer
PysProp(0).name = "AsTemplate"
PysProp(0).value = true
PysLettreType = thiscomponent
PysUrl = PysLettreType.url
' Ne travaille que si le document a été enregistré (car on l'utilise par insertion > fichier)
if PysUrl <> "" and not(PysLettreType.isModified) then
' Création d'un nouveau document fondé sur la letre-type
PysNewDoc = stardesktop.loadComponentFromUrl(PysUrl, "_blank", 0, PysProp())
' Chargement de la bibliotheque Tools car utilisation des fonctions IndexinArray et ToggleWindow
GlobalScope.BasicLibraries.LoadLibrary("Tools")
PysPatienter
ToggleWindow false
' Ne travaille que si le document comprend un formulaire
if PysNewDoc.DrawPage.Forms.count <> 0 then
PysForm = PysNewDoc.DrawPage.Forms.getByIndex(0)
' Ne travaille que si le formulaire ne comprend qu'un seul contrôle (picto)
if PysForm.count = 1 then
' Accès à ce contrôle
PysCtrlImg = PysForm.getByIndex(0)
' On remonte du formulaire à la "connexion" utile pour :
' - créer le jeu d'enregistrements
' - accéder aux formats de données
PysConnexion = PysForm.ActiveConnection
if IsNull(PysConnexion) then
MsgBox("Connexion impossible", 16)
else
PysTables = PysConnexion.Tables
' Ne travaille que si la source ne comprend qu'une table
if PysTables.count = 1 then
' Création du jeu d'enregistrements correspondant
PysRowSet = createUnoService("com.sun.star.sdb.RowSet")
with PysRowSet
.activeConnection = PysConnexion
.CommandType = "com.sun.star.sdb.CommandType.Table"
.Command = PysConnexion.Tables.getByIndex(0).Name
.Filter = "memoire = 'oui'"
.ApplyFilter = True
.execute
end with
' Utilise la fonction (Tools) pour tester si la source de données comprend
' un champ de même nom que le contrôle Image
if IndexinArray(PysCtrlImg.name, PysRowSet.Columns.ElementNames) <> -1 then
' Toutes les conditions sont réunies, on peut "boucler" sur les enregistrements
with PysRowSet
.beforeFirst
PysNbForms = 0
while .next
' Pour le premier enregistrement, le document a déjà été créé, sinon
' on va à la fin du document, on insère un paragraphe avec saut de page
' puis on insère la lettre-type à la fin
if PysNbForms <> 0 then
URL = PysRowSet.Columns.getByName("URL").String
EXT = PysRowSet.Columns.getByName("EXTPHOTO").String
PysTexte = PysNewDoc.text
PysCurseur = PysTexte.createTextCursor
PysCurseur.gotoEnd(False)
PysTexte.insertControlCharacter(PysCurseur, com.sun.star.text.ControlCharacter.PARAGRAPH_BREAK, false)
PysCurseur.breakType = com.sun.star.style.BreakType.PAGE_BEFORE
PysCurseur.insertDocumentFromURL(PysUrl, array())
PysForm = PysNewDoc.DrawPage.Forms.getByIndex(PysNbForms)
PysCtrlImg = PysForm.getByIndex(0)
end if
' Assignation de l'url de l'image (contenue dans le champ de même nom dans la table)
PysCtrlImg.ImageUrl = convertToUrl(URL & .columns.getByName(PysCtrlImg.name).String & EXT)
PysNbForms = PysNbForms + 1
'Boucle sur les champs du document (et non de la source...)
PysEnum = PysNewDoc.TextFields.createEnumeration
' Tant qu'il y en a...
do while PysEnum.hasMoreElements
PysChamp = PysEnum.nextElement
' S'il s'agit d'un champ lié à la base de données
if PysChamp.supportsService("com.sun.star.text.TextField.Database") then
' Vérifie qu'il y a bien un champ du même nom
if IndexinArray(PysChamp.TextFieldMaster.DataColumnName, PysRowSet.Columns.ElementNames) <> -1 then
' Récupération de la position du champ dans le document
PysRange=PysChamp.anchor.start
' Création d'un curseur d'écriture pour remplacer le champ par le texte contenu
' dans la base
PysCurseur = PysRange.text.createTextCursorByRange(PysRange)
' Nécessaire de formater les champs Date ou Numérique
' avant d'écrire le contenu du champ
select case .columns.getByName(PysChamp.TextFieldMaster.DataColumnName).TypeName
case "DATE","DATETIME","TIME"
PysCurseur.string =_
PysFormat(.columns.getByName(PysChamp.TextFieldMaster.DataColumnName).String,_
.columns.getByName(PysChamp.TextFieldMaster.DataColumnName).FormatKey)
case "DECIMAL","NUMERIC"
PysCurseur.string =_
PysFormat(val(.columns.getByName(PysChamp.TextFieldMaster.DataColumnName).String),_
.columns.getByName(PysChamp.TextFieldMaster.DataColumnName).FormatKey)
case else
PysCurseur.string =.columns.getByName(PysChamp.TextFieldMaster.DataColumnName).String
end select
' Supprime le champ
PysChamp.dispose
end if
end if
loop
' Met à jour la collection des champs du document
PysNewDoc.TextFields.refresh
wend
.dispose
end with
else
MsgBox("Aucun champ nommé " & PysCtrlImg.name & " ne figure dans la source de données", 16)
end if
else
MsgBox("Table non trouvée", 16)
end if
end if
else
MsgBox("Impossible de trouver le contrôle image dans le formulaire", 16)
end if
else
MsgBox("Aucun formulaire n'a été trouvé", 16)
end if
ToggleWindow true
PysFinPatienter
msgbox "Terminé...", 64, "Publipostage"
else
MsgBox("La lettre type doit avoir été enregistrée", 16)
end if
End Sub
sub PysPatienter
' Affiche un dialogue d'attente à l'utiliateur
dim PysBibli as Object, PysMonDialog as object, PysControle as object
DialogLibraries.LoadLibrary("PysPublipostage")
PysBibli=DialogLibraries.GetByName("PysPublipostage")
PysMonDialog=PysBibli.GetByName("PysDlgPatienter")
PysDlg=CreateUnoDialog(PysMonDialog)
PysDlg.setVisible(True)
PysDlg.model.PysTextMsg.Text="Veuillez patienter..."
' Nécessaire pour laisser le temps à la connexion à la source de données de s'établir
wait 20
end sub
sub PysFinPatienter
PysDlg.setVisible(False)
PysDlg.Dispose
end sub
function PysFormat(PysChamp, PysKey as long) as string
' A partir du numéro de format (PysKey) on recherche dans les formats, on obtient ainsi la chaîne représentant le format
' Par exemple : # ##0,00 [$€-40C];[RED]-# ##0,00 [$€-40C]
' Appel de la fonction Calc FORMAT (TEXT en GB) pour formater le contenu du champ avec ce format
' Nota : on ne peut utiliser la propriété NumberFormats de "thiscomponent" (la lettre-type) car les formats sont différents.
' On appelle donc logiquement le NumberFormatsSupplier de la "database" à laquelle on remonte via la Connexion.
dim PysService as object
PysService = CreateUnoService("com.sun.star.sheet.FunctionAccess")
PysFormat = PysService.callFunction("TEXT", array(PysChamp, PysConnexion.Parent.NumberFormatsSupplier.NumberFormats.getByKey(PysKey).FormatString))
end function
Chapalu