Code : Tout sélectionner
Sub ListeImages
' ****************************************************
' Macro fournie par le forum officiel OOo / LibO
' http://user.services.openoffice.org/fr/forum
' Merci de garder le présent encart si vous réutilisez
' tout ou partie de ce code
' ****************************************************
Dim sRep As string
sRep = "c:\temp\" ' Modifier le chemin si Linux
Dim oDoc As Object
Dim oImages As Object, oImage As Object
Dim sImageUrl as string, sImageExt as string
Dim sImage as string
Dim mData() as variant
Dim oFic as Object, oExp as object
oDoc = ThisComponent
oImages = oDoc.GraphicObjects
' Prendre la 1ere image intégrée (index à zéro)
oImage = oImages(0)
' Extraire son nom
sImageUrl = Mid (oImage.GraphicURL, 28)
' Quel est le type de l'image
sImageExt = Right (oImage.Graphic.MimeType, 3)
' Ce qui donne le nom comlet
sImage = sImageUrl & "." & sImageExt
' Extraction du fichier dans un flux binaire
oFic = oDoc.DocumentStorage.getByName("Pictures").getByName(sImage)
oFlux = oFic.InputStream
oURL = ConvertToUrl(sRep & sImage)
kill oURL
' Export dans le fichier
oExp = CreateUnoService("com.sun.star.ucb.SimpleFileAccess")
ofw = oExp.openFileWrite(oURL)
n = -1
While n <> 0
n = oFlux.readBytes(mData(), 50000)
ofw.writeBytes(mData())
Wend
ofw.flush()
ofw.closeOutput()
End sub
Ajout : Sur le conseil judicieux de Churay, il est recommandé de tester plus fortement le type MIME du fichier. Ce dernier pouvant donner des surprises comme expliqué dans ce sujet. |