Bonsoir, Le calcul des dimensions d'une sélection d'objets fonctionne, mais j'ai dû passer le type int en long parce que j'avais des images qui dépassaient les limites.
J'ai repris ma macro d'exportation d'image et Je l'ai généralisée pour les formats png et jpeg, soit en pleine page, soit sur la sélection, sur une base de densité de pixels en DPI, mais en laissant la possibilité de faire un tableau de dimensions en pixels si l'on souhaite.
Les images sont exportées avec le nom du fichier, le numéro, le nom de la page, une extension qui dépend si c'est la petite ou la grande image, dans le répertoire du fichier, avec deux images (une grande et une petite) pour chaque page. Si vous voulez une seule taille par page, mettez la même définition et la même extension pour les deux tailles d'images.
J'ai fait des essais d'exportation en bmp, mais Je ne contrôle pas correctement les dimensions des grandes images qui plafonnent.
Est-ce que quelqu'un saurait comment sélectionner/déselectionner une couche en basic ?
Voici donc la mise à jour:
REM ***** BASIC *****
'Exportation automatique de pages Libre office draw vers un format image bitmap, une image par page
sub ExportFullPng 'exporte la pleine page
ExportImg ("png", false, 220, 100, ".p", ".s")
end sub
sub ExportFullJpg
ExportImg ("jpg", false, 220, 100, ".p", ".s")
end sub
sub ExportSelPng 'exporte uniquement les graphismes de la page (sélection automatique)
ExportImg ("png", true, 220, 100, ".p", ".s")
end sub
sub ExportSelJpg
ExportImg ("jpg", true, 220, 100, ".p", ".s")
end sub
sub ExportSelBmp 'exporte, mais la définition n'est pas claire, seul le paramètre de la petite image semble avoir un effet
ExportImg ("bmp", true, 220, 50, ".p", ".s")
end sub
Sub ExportImg (format, selection, dpiLarge, dpiSmall, aEXtp, aEXts) 'Exporte la selection complete de chaque page en fonction de dpi
'aEXtp = 'extension de la grande image
'aEXts = 'extension de la petite image
REM Filter dependent filter properties
Dim aFilterData (10) 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
'aEXtp, aEXts
Dim defdpi as Integer
Dim selWidth,selHeight as Long
Dim cfRed, hratio as double
Dim gsize (2)
'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","tableau","entrees_d_air")
'Vous pouvez imposer les dimensions d'image au lieu des densités de pixels en remplissant ces tableaux -> les dpi images seront erronés
'arrWidthp = 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,220)
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)
if (selection) then
fDoc = oDoc.CurrentController.Frame
dispatcher = createUnoService("com.sun.star.frame.DispatchHelper")
dispatcher.executeDispatch(fDoc, ".uno:SelectAll", "", 0, Array()) 'sélectionne tous les éléments
end if
xView = oDoc.currentController
xObj = xView.currentPage
xSelection = xView.selection
If not(selection) or isEmpty(xSelection) then
xObj = xView.currentPage
selWidth = oDrawPage.Width 'Largeur de la page
selHeight = oDrawPage.Height 'Largeur de la page
else
xObj = xSelection
gsize = calcSize(xObj) 'Calcule la largeur des éléments sélectionnés
selWidth = gsize(0)
selHeight = gsize(1)
End If
hratio = selHeight/selWidth
aPage = "_p"+ (i+1) 'nom de la page par défaut
' PARAMETRES D'EXPORTATION
aFilterData(0).Name = "PixelWidth"
aFilterData(0).Value = Int(selWidth*(dpiLarge/2540))
on error Resume Next
aPage = "_"+pageName(i) 'nomme la page si eelle est dans un tableau
aFilterData(0).Value = arrWidthp(i) 'définit la largeur si elle est dans un tableau
on error Goto 0
aFilterData(1).Name = "PixelHeight"
aFilterData(1).Value = Int(hratio*aFilterData(0).Value)
' compression - png
aFilterData(2).Name ="Compression"
aFilterData(2).Value = 9 'de 0 à 9
' entrelacement - png
aFilterData(3).Name ="Interlaced"
aFilterData(3).Value = 0
' transparence (png - doit être faux, sinon problème de lisibilité)
aFilterData(4).Name = "Translucent"
'Paramètres pour exportation jpeg
aFilterData(4).Value = false
aFilterData(7).Name = "Resolution"
aFilterData(7).Value = dpiLarge 'Requis pour fichier bmp, mais le fonctionnement n'est pas clair
aFilterData(8).Name ="LogicalWidth"
aFilterData(8).Value = aFilterData(0).Value*2540/dpiLarge
aFilterData(9).Name ="LogicalHeight"
aFilterData(9).Value = aFilterData(1).Value*2540/dpiLarge
aFilterData(10).Name ="Quality"
aFilterData(10).Value = 85
oDoc.CurrentController.setCurrentPage(oDrawPage)
sFileUrl = curFile + aPage + aExtp + "." + format
Export (xObj, sFileUrl, aFilterData(), format) 'Exporter grande image
Wait 500
aFilterData(0).Value = Int(selWidth*(dpiSmall/2540))
on error Resume Next
aFilterData(0).Value = arrWidths(i)
on error Goto 0
aFilterData(1).Value = Int(hratio*aFilterData(0).Value)
if format="bmp" then
aFilterData(8).Value = Int(aFilterData(8).Value*dpiSmall/dpiLarge)
aFilterData(9).Value = Int(aFilterData(9).Value*dpiSmall/dpiLarge)
end if
sFileUrl = curFile + aPage + aExts + "." + format
Export (xObj, sFileUrl, aFilterData(), format) 'Exporter petite image
Wait 500
Next i
oDrawPage = oDoc.getDrawPages().getByIndex(0)
oDoc.CurrentController.setCurrentPage(oDrawPage)
End Sub
Sub Export (xObject, sFileUrl As String, aFilterData, format)
Dim xExporter, mediaExt
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
if format="jpg" then
mediaExt = "jpeg" ' "image/jpg" ne fonctionne pas correctement
else
mediaExt = format
end if
aArgs(0).Name = "MediaType"
aArgs(0).Value = "image/"+mediaExt
aArgs(1).Name = "URL"
aArgs(1).Value = aURL
aArgs(2).Name = "FilterData"
aArgs(2).Value = aFilterData
xExporter.filter(aArgs())
End Sub
function calcSize (oObj) 'oObj est une selection d'objets graphiques dont on calcule les dimensions
Dim x0, y0, x1, y1 As Long 'La hauteur peut dépasser 32000-> entier long
x0=oObj(0).Position.X
y0=oObj(0).Position.Y
x1=x0+oObj(0).Size.Width
y1=y0+oObj(0).Size.Height
For i=1 To (oObj.Count-1)
If (oObj(i).Position.X<x0) Then x0=oObj(i).Position.X
If (oObj(i).Position.Y<y0) Then y0=oObj(i).Position.Y
If ((oObj(i).Position.X+oObj(i).Size.Width)>x1) then x1=oObj(i).Position.X+oObj(i).Size.Width
If ((oObj(i).Position.Y+oObj(i).Size.Height)>y1) then y1=oObj(i).Position.Y+oObj(i).Size.Height
Next i
calcSize = array(x1-x0, y1-y0)
end function
Salutations, Pierre
![[TEST] Document Foundation Community](https://communitytest.documentfoundation.org/images/discourse-logo-sketch.png){kind=logo}
