Merci, c'est ce que je recherchais, mais le premier message n'est pas
arrivé dans ma boite mail.
J'ai modifié les macros pour :
- Exporter chaque page (dans le répertoire courant, avec le nom du
fichier source+le numéro de page)
- Exporter deux images a des définitions différentes pour chaque page
- Avoir en option un nom à la place du numéro de page, stocké dans un
tableau
Le nombre de pixels n'est pris en compte que s'il est entier, les
valeurs décimales ne marchent pas.
J'ai fait deux variantes
- Export2png qui exporte la totalité de chaque page avec une densité de
pixel définie (en dpi)
- ExportSelPng qui n'exporte que ce qui est visible (sélectionner tout),
avec une largeur d'image fixée en pixels
Pour la deuxième variante, on peut en option saisir des tableaux
définissant la largeur de chaque image. Si le tableau n'est pas rempli,
la largeur par défaut est utilisée.
J'ai essayé de faire une variante d'exportation en jpg, dans ce cas il
faut utiliser les variables LogicalHeight et LogicalWidth avec un
coefficient, mais pour une raison inconnue, Je ne peut pas avoir
d'images de plus de 497 pixels de large.
Salutations, Pierre
REM ***** BASIC *****
Sub Export2png 'Exporte la pleine page sur une densité de pixels
REM Filter dependent filter properties
Dim aFilterData (4) As New com.sun.star.beans.PropertyValue
Dim sFileUrl As String
Dim oDoc AS Object
Dim oDrawPage As Object
Dim curFile, aFile, aPage as string
Dim defdpi as integer
Dim cfRed as double
Dim wd, ht as long
'Ce qui suit est un exemple pour nomme les pages (au lieu de p1, p2, etc.)
pageName = array ("Nom_Page_1","Nom_Page_2")
defdpi= 160 ' densité de pixel en dpi export pour la grande image (.p.png)
cfRed = 0.32 'Coefficient de réduction pour l'image réduite (.s.png)
oDoc = thisComponent
curFile = ThisComponent.getURL()
curFile = Left(curFile, Len(curFile)-4) 'Supprime l'extension de fichier
(.odg)
For i = 0 to oDoc.getDrawPages().Count-1 'Balaye toutes les pages
oDrawPage = oDoc.getDrawPages().getByIndex(i)
oDoc.CurrentController.setCurrentPage(oDrawPage)
xObj = oDoc.currentController.currentPage
' PARAMETRES D'EXPORTATION
aFilterData(0).Name = "PixelWidth"
aFilterData(0).Value = Int(oDrawPage.Width*(defdpi/2540))
aFilterData(1).Name = "PixelHeight"
aFilterData(1).Value = Int(oDrawPage.Height*(defdpi/2540))
' compression
aFilterData(2).Name ="Compression"
aFilterData(2).Value = 9 'de 0 à 9
' entrelacement
aFilterData(3).Name ="Interlaced"
aFilterData(3).Value = 0
' transparence
aFilterData(4).Name = "Translucent"
aFilterData(4).Value = false
aPage = "_p"+ (i+1)
on error Resume Next
aPage = "_"+pageName(i)
aFilterData(0).Value = arrWidthp(i)
on error Goto 0
sFileUrl = curFile + aPage + ".p.png"
ExportPng( xObj, sFileUrl, aFilterData() )
Wait 500
aFilterData(0).Value = Int(aFilterData(0).Value * cfRed)
aFilterData(1).Value = Int(aFilterData(1).Value * cfRed)
on error Resume Next
aFilterData(0).Value = arrWidths(i)
on error Goto 0
sFileUrl = curFile + aPage + ".s.png"
ExportPng( xObj, sFileUrl, aFilterData() )
Wait 500
Next i
End Sub
Sub ExportSelPng 'Exporte la selection complete de chaque page sur une
largeur fixée
REM Filter dependent filter properties
Dim aFilterData (8) As New com.sun.star.beans.PropertyValue
Dim sFileUrl As String
Dim oDoc, fDoc, dispatcher AS Object
Dim oDrawPage As Object
Dim curFile, aFile, aPage as string
Dim defdpi, par as integer
Dim cfRed as double
Dim wd, ht as long
'Nomme les pages, pour remplacer le numéro de page - ce qui suit est un
exemple
pageName = array
("sens","pose","tapees","accouplees","battement","volets_pliants","montages_speciaux","types_courants","autres_types","symboles","symboles2","details","loqueteau")
'largeurs par défaut
widthp = 1536 ' Largeur par défaut de la grande image - la hauteur
s'ajuste automatiquement
widths = 576 ' Largeur par défaut de la petite image
'Tableaux des largeurs si non constantes
arrWidths = array
(1536,1536,1536,1536,1536,1536,1536,1536,1536,1536,1536,1536,800)
arrWidths = array (640,576,512,512,576,512,512,576,576,512,512,640,172)
oDoc = ThisComponent
curFile = ThisComponent.getURL()
curFile = Left(curFile, Len(curFile)-4) 'Supprime l'extension de fichier
(.odg)
For i = 0 to oDoc.getDrawPages().Count-1 'Balaye toutes les pages
oDrawPage = oDoc.getDrawPages().getByIndex(i)
oDoc.CurrentController.setCurrentPage(oDrawPage)
' PARAMETRES D'EXPORTATION
aFilterData(0).Name = "PixelWidth"
aFilterData(0).Value = widthp
'aFilterData(1).Name = "PixelHeight"
'aFilterData(1).Value =
' compression
aFilterData(2).Name ="Compression"
aFilterData(2).Value = 9 'de 0 à 9
' entrelacement
aFilterData(3).Name ="Interlaced"
aFilterData(3).Value = 0
' transparence
aFilterData(4).Name = "Translucent"
aFilterData(4).Value = false
aFilterData(6).Name = "ExportMode"
aFilterData(6).Value = 0
fDoc = oDoc.CurrentController.Frame
dispatcher = createUnoService("com.sun.star.frame.DispatchHelper")
dispatcher.executeDispatch(fDoc, ".uno:SelectAll", "", 0, Array())
xObj = oDoc.currentController.currentPage
xView = oDoc.currentController
'Select all components of this page
xSelection = xView.selection 'pour pouvoir exporter une sélection
correctement, il faudrait connaitre ses dimensions
If isEmpty( xSelection ) Then
xObj = xView.currentPage
Else
xObj = xSelection
End If
aPage = "_p"+ (i+1)
on error Resume Next
aPage = "_"+pageName(i)
aFilterData(0).Value = arrWidthp(i)
on error Goto 0
oDoc.CurrentController.setCurrentPage(oDrawPage)
sFileUrl = curFile + aPage + ".p.png"
ExportPng (xObj, sFileUrl, aFilterData())
Wait 500
aFilterData(0).Value = widths
on error Resume Next
aFilterData(0).Value = arrWidths(i)
on error Goto 0
sFileUrl = curFile + aPage + ".s.png"
ExportPng (xObj, sFileUrl, aFilterData())
Wait 500
Next i
End Sub
Sub ExportPng( xObject, sFileUrl As String, aFilterData )
Dim xExporter
xExporter = createUnoService( "com.sun.star.drawing.GraphicExportFilter" )
xExporter.SetSourceDocument(xObject)
Dim aArgs (2) As New com.sun.star.beans.PropertyValue
Dim aURL As New com.sun.star.util.URL
aURL.complete = sFileUrl
aArgs(0).Name = "MediaType"
aArgs(0).Value = "image/png"
aArgs(1).Name = "URL"
aArgs(1).Value = aURL
aArgs(2).Name = "FilterData"
aArgs(2).Value = aFilterData
xExporter.filter( aArgs() )
End Sub
Le 01/12/2016 à 09:28, Agnès Simonet a écrit :
Bonjour,
Le 30/11/2016 21:37, Pierre ROUZEAU a écrit :
Il n'y a pas d'espoir du coté des macros ? Sans enregistreur, comment
connaitre la syntaxe ?
Si, mais il faut lire les réponses à la question posée ;-)
http://listarchives.libreoffice.org/fr/users/msg28946.html
Cordialement
Agnès S.
---
L'absence de virus dans ce courrier électronique a été vérifiée par le
logiciel antivirus Avast.
https://www.avast.com/antivirus