resize image Dorange-Pattoret Didier How can I resize an external from inside my OpenOffice without using any external programm. Sub Essai ResizeExternalImageByWidth("/home/didier/tmp4/about.bmp","/home/didier/tmp4/about_1616.bmp",16) End sub Sub ResizeExternalImageByWidth(sURLImage,sURLImageResized as String, iWidth as Integer) rem open a sdraw hidden document Dim mFileProperties(0) As New {@see com.sun.star.beans.PropertyValue} Dim Proportion as Single mFileProperties(0).Name="Hidden" mFileProperties(0).Value=True oDesktop=createUnoService("{@see com.sun.star.frame.Desktop}") monDocument = oDesktop.LoadComponentFromURL("private:factory/sdraw","_blank",0,mFileProperties()) maPage = monDocument.DrawPages(0) rem insert in the drawpage the image resized at 1000 ImageL = monDocument.createInstance("{@see com.sun.star.drawing.GraphicObjectShape}") ImageL.GraphicURL = ConvertToURL(sURLImage) maPage.add(ImageL) resizeImageByWidth(ImageL,1000) rem resizing the drawpage Proportion = ImageL.Size.Height/ImageL.Size.Width maPage.Width = 1000 maPage.Height = ArrondiEntier(1000*Proportion) rem set export data Dim aFilterData (1) as new {@see com.sun.star.beans.PropertyValue} aFilterData(0).Name = "PixelWidth" ' aFilterData(0).Value = iWidth aFilterData(1).Name = "PixelHeight" aFilterData(1).Value = ArrondiEntier(iWidth*Proportion) rem export drawpage Export( maPage,sURLImageResized , aFilterData() ) On error resume Next monDocument.Close(True) On error goto 0 End Sub Function ArrondiEntier(Nombre as Single) as Integer If Nombre-Int(Nombre) < 0.5 Then ArrondiEntier = Int(Nombre) Else ArrondiEntier = Int(Nombre)+1 Endif End Function Sub Export( xObject, sFileUrl As String, aFilterData ) xExporter = createUnoService( "{@see com.sun.star.drawing.GraphicExportFilter}" ) xExporter.SetSourceDocument( xObject ) Dim aArgs (2) as new {@see com.sun.star.beans.PropertyValue} Dim aURL as new {@see com.sun.star.util:URL} sFileUrl = ConvertToURL(sFileUrl) aArgs(0).Name = "FilterName" aArgs(0).Value = "bmp" aArgs(1).Name = "URL" aArgs(1).Value = sFileUrl aArgs(2).Name = "FilterData" aArgs(2).Value = aFilterData xExporter.filter( aArgs() ) End Sub Sub resizeImageByWidth(uneImage As Object, largeur As Long) Dim leBitMap As Object, Proportion As Double Dim Taille1 As New {@see com.sun.star.awt.Size} LeBitmap = uneImage.GraphicObjectFillBitmap Taille1 = LeBitMap.Size ' taille in pixels ! Proportion = Taille1.Height / Taille1.Width Taille1.Width = largeur ' largeur en 1/100 de mm Taille1.Height = Taille1.Width * Proportion uneImage.Size = Taille1 End Sub