macro pour générer les fiches d'inscriptions personnalisées "dites-le nous une seule fois".

unefois.lob

REM  *****  BASIC  *****

Sub Main

Dim Doc As Object
Dim Url As String
Dim Dummy() 'It is an (empty) array of PropertyValues
Dim oDocProps as object
Dim oProps    as object
Dim iRow as Integer
Dim ThisDoc As Object
Dim Sheet As Object
Dim Cell As Object   
 
 

ThisDoc = ThisComponent
Sheet = ThisDoc.Sheets(0)

 
Url = "file:///D:/tmp/Siinge_Bulletin_d_adhésion_2016-2017.odt"

'rows are numbered from 0, not as displayed
For iRow = 1 to 17
	Doc = StarDesktop.loadComponentFromURL(Url, "_blank", 0, Dummy)
	oDocProps = Doc.getDocumentProperties()
	oProps = oDocProps.UserDefinedProperties
	If  Sheet.getCellByPosition(1, iRow).String <> "" Then
		oProps.[nom] = Sheet.getCellByPosition(1, iRow).String
	End If
	If  Sheet.getCellByPosition(0, iRow).String <> "" Then
		oProps.[prenom] = Sheet.getCellByPosition(0, iRow).String
	End If
	If  Sheet.getCellByPosition(8, iRow).String <> "" Then
		oProps.[adresse] = Sheet.getCellByPosition(8, iRow).String
	End If
	If  Sheet.getCellByPosition(5, iRow).String <> "" Then
		oProps.[telephone] = Sheet.getCellByPosition(5, iRow).String
	End If
	If  Sheet.getCellByPosition(7, iRow).String <> "" Then
		oProps.[ne_le] = Sheet.getCellByPosition(7, iRow).String
	End If
	If  Sheet.getCellByPosition(6, iRow).String <> "" Then
		oProps.[a_prevenir] = Sheet.getCellByPosition(6, iRow).String
	End If
	If  Sheet.getCellByPosition(9, iRow).String <> "" Then
		oProps.[email] = Sheet.getCellByPosition(9, iRow).String
	End If
	Doc.storeAsURL("file:///D:/tmp/siinge_perso_" & oProps.[nom] & ".odt", Dummy)
	exportToPdf(Doc, "file:///D:/tmp/siinge_perso_" & oProps.[nom] & ".pdf")
	Doc.close(true)
Next iRow
End Sub



Sub setProp(prop, valueString)
	If valueString <> "" Then
		prop = valueString
	End If
End Sub


Sub exportToPdf(doc, path)
	Dim aMediaDescriptor(0) as new com.sun.star.beans.PropertyValue
	aMediaDescriptor(0).Name = "FilterName"
	aMediaDescriptor(0).Value = "writer_pdf_Export"
	doc.storeToURL(path, aMediaDescriptor)
End Sub