[Résolu] [Writer] Extraire les images d'un document

[webber]

Bonjour,

Si j'ai bien compris, dans un document OOo, les images sont insérées dans l'ODT ou non. Celles qui sont insérées sont dans un répertoire Pictures (contenu dans le zip formant l'ODT).
Je souhaiterais via une macro être capable de lister les images d'un document afin de récupérer les noms et chemins des images liées (donc externes) et récupérer les noms et extraires les images non liées afin de les déposer dans un répertoire.


Si possible, si vous avez un lien vers la documentation de gestion des images, ça me permettrait de chercher mieux chercher aussi.

Merci,

Cordialement,

[spYre]

Bonjour webber,

Il existe ce suprême de code : http://codesnippets.services.openoffice ... ctGfx.snip.
Il nécessite aujourd'hui quelques modifications, comme précisé ici : h**p://www.oooforum.org/forum/viewtopic.phtml?t=66532 (lien mort).

Ce code extrait les images du document Writer dans un répertoire Pictures (créé dans le répertoire du document) et remplace les images stockées par un lien vers ce nouveau répertoire.

N'hésite pas si l'anglais pose problème...

Cordialement.

[Dude]

Salut,

J'avais répondu à cette question ici : http://user.services.openoffice.org/fr/ ... ste+images

Néanmoins, pourquoi s'embêter avec une macro ? Il suffit d'enregistrer au format HTML pour qu'il y ait extraction des images.

[Churay]

Bonjour

Je n'ai pas été bon sur ce coup... Tant pis, je donne quand même ma solution :

Code : Tout sélectionner

Sub Adr_images
	oForm = thisComponent.GraphicObjects
	oEnum = oForm.createEnumeration 
	sTxt = "" 
	Do while oEnum.hasMoreElements
		oGraph = oEnum.nextElement
		sTxt = sTxt & oGraph.Name & " : " & oGraph.GraphicURL & chr(10)
	Loop

	msgBox sTxt		
End Sub

Ajout : et je n'avais pas tout lu, encore une fois... Donc pour la finalité : Néanmoins, pourquoi s'embêter avec une macro ? Il suffit d'enregistrer au format HTML pour qu'il y ait extraction des images. Dude ? Il est trop bon...

Ajout : 2 si vous avez un lien vers la documentation de gestion des images, ça me permettrait de chercher mieux chercher aussi. En ce qui me concerne la doc se résume de plus en plus à -1- XRay + SDK, -2- les codes et suprêmes du forum -3- si quelquechose m'échappe au point 2, retour en 1 avec la propriété / méthode obscure

Ajout : 3 Ajout de & chr(10) pour que ce soit un peu plus présentable

[webber]

Merci à tous pour vos réponses, c'est sympa.

Néanmoins, pourquoi s'embêter avec une macro ? Il suffit d'enregistrer au format HTML pour qu'il y ait extraction des images.

Parce que la macro fera d'un ensemble de macro regrouper dans une extension. Si je suis tout à fait d'accord avec toi que le plus simple est ta suggestion.

J'ai récupérer le code de Churay pour récupérer les noms des images. Il ne me reste plus qu'à trouver comment les extraire.

[Churay]

Il ne me reste plus qu'à trouver comment les extraire.

C'est-à-dire ? Les placer dans un répertoire précis ?

[webber]

Il ne me reste plus qu'à trouver comment les extraire.

C'est-à-dire ? Les placer dans un répertoire précis ?

Oui je souhaiterai les extraire de l'ODT pour les mettre dans un répertoire donné ou que je peux créer.

[Churay]

Avant la boucle :
- demander ou définir le dossier cible (sRep)
- vérifier l'existence du dossier : s'il n'existe pas le créer (mkDir sRep)

Dans la boucle, au lieu de sTxt = sTxt & oGraph.Name & " : " & oGraph.GraphicURL & chr(10), il faut :

• - sSource = oGraph.GraphicURL
  - séparer le chemin du nom
  - remplacer le chemin par ce dossier cible pour bâtir l'url sCible
  - copier : FileCopy sera le plus simple à utiliser (FileCopy sSource, sCible )

[webber]

Merci, je fais la procédure et la propose ici.
Je ne savais pas qu'un FileCopy suffisait pour l'extraction du fichier.

[Churay]

Effectivement, avec une url de type vnd.sun.star.GraphicsObject, un filecopy va avoir du mal

Je regarde demain

[webber]

J'ai honte j'y arrive pas.

Code : Tout sélectionner

' Sauvegarde des images
Sub extraire_images
	
	Dim oForm As Object, oEnum As Object, oGraph As Object
	Dim cheminImage As String, repertoire As String
	Dim nouvelleImage As String, sSource As String
	
    oForm = thisComponent.GraphicObjects
    oEnum = oForm.createEnumeration
    cheminImage  = ""
   
    Do while oEnum.hasMoreElements
    	oGraph	    = oEnum.nextElement
		sSource     = oGraph.GraphicURL 
      	cheminImage = "Nom : " & oGraph.Name & " : URL => " & sSource
		msgBox(  cheminImage )

		Dim oObj As Object, Cible As Object, nomFichier As String, Valeur As Object, obtenirNomFichier As String
		oObj              = createUnoService("com.sun.star.bridge.OleObjectFactory") 
		Cible             = oObj.createInstance("Scripting.fileSystemObject")
		Valeur            = Cible.GetFile( sSource )
        FileCopy(sSource, ConvertToURL("C:Temp\" & Valeur) )
    Loop
       
End Sub

Surement la fatigue !!

[Dude]

Sans tester, je peux te dire que ton chemin n'est pas bon :

Code : Tout sélectionner

FileCopy(sSource, ConvertToURL("C:Temp\" & Valeur) )

Ce serait plutôt un truc comme :

Code : Tout sélectionner

C:\Temp\

Pour t'en assurer, il te suffit de regarder le code erreur que retourne l'instruction FileCopy :

Codes d'erreur
5 Appel de procédure non valide
76 Chemin introuvable

[Churay]

J'ai honte j'y arrive pas.

Ce serait plus à moi à faire profil bas pour t'avoir aiguillé sur une fausse piste...

Ce matin n'ayant pas la Bible sous la main, j'ai fait chauffer XRay et découvert plein de choses sympas.
Et je suis allé voir du côté de Pythoniak, Breewer et quelques autres, chez qui j'ai complété mes découvertes.
Et de manière empirique, j'ai [re]découvert le fil à couper le beurre...
Entre midi et deux, j'ai jeté un oeil dans la Bible et

Depuis un document Writer il n'est pas possible d'exporter une image car cet objet n'a pas les caractéristiques nécessaires

Voili, voilou... Il ne reste plus qu'à contourner...
Une solution qui me semble simple (à vérifier quand même, vu mes raccourcis parfois aventureux) :
reprendre la solution de Dude par macro, aller chercher les images pour les transférer, nettoyer.

Concernant, le test de l'existence du dossier :

Code : Tout sélectionner

Sub Adr_images
	oForm = thisComponent.GraphicObjects
	oEnum = oForm.createEnumeration 
	Do
		' saisie d'un chemin
		sDirCible = InputBox("Veuiller saisir le chemin complet","Dossier d'enregistrement") 
		'
		' une annulation possible avec le mot "fin" (cala aurait pu être une chaine vide)
		IF UCase(sDirCible) = "FIN" Then exit sub
		'
		' Si rien n'a été saisi -> un dossier par défaut
		IF Len(sDirCible) = 0 Then sDirCible = "C:\Temp\"
		'
		' Test de cohérence (partiel) d'un nom de fichier Windows
		IF Right(sDirCible,1) <> "\" Then sDirCible = sDirCible & "\"
		IF Mid(sDirCible,2,1) = ":" AND Mid(sDirCible,3,1) = "\" Then
			nRet = MsgBox ( sDirCible , 4, "Confirmation de chemin ") 
		else 
			MsgBox "Chemin incorrect", 16, "Attention"
		End IF
		'  Confirmation = "Oui"
	Loop Until nRet = 6

	' Si le dossier n'existe pas, on le crée
	sRet = Dir(sDirCible ,16) : If sRet = "" Then mkDir(sDirCible )

	' On boucle sur les images du document
	Do While oEnum.hasMoreElements
		oGraph  = oEnum.nextElement ' : sSource = oGraph.GraphicURL 
		sCible = convertToUrl( sDirCible & oGraph.Name & ".jpg")

		Save_As_Jpg(oGraph , sCible)
	Loop 
'	thisComponent.Store
End Sub

Le Save_As_Jpg reste à venir Mais ça va viendre...
De manière très certainement fort différente

[Dude]

Effectivement, un FileCopy ne fonctionne qu'avec des URL et comme l'indique l'aide F1 :

L'instruction FileCopy ne peut être appliquée que pour copier des fichiers non ouverts.

On peut cependant récupérer le flux binaire de l'image et le rediriger vers un fichier : http://user.services.openoffice.org/fr/ ... 29696.html

[Churay]

Ca marche nickel, sauf qu'étant particulièrement doué, je suis allé tester sur des images que je croyais normales
mais dont le type mime révèle des surprises (x-vclgraphic : non reconnu)...

Il faut donc, pour une fonction un peu généraliste, le gérer plus finement que sur les 3 derniers caractères, j'en suis à :

Code : Tout sélectionner

	Select case oGraph.Graphic.MimeType
	Case "image/jpeg", "image/jpg"	' jpg
	Case "image/tiff", "image/tif"		' tiff
	Case "image/x-photo-cd"			' pcd
	Case "image/x-xpixmap"			' xpm
	Case "image/x-xbitmap"			' xbm
	Case "image/x-portable-bitmap"		' pgm
	Case "image/x-portable-graymap"	' pgm
	Case "image/x-portable-pixmap"	' pgm
	Case "image/x-pict"				' pict
	Case "image/x-cmu-raster"		' ras ?
	Case "image/x-targa"			' tga
	Case "image/x-photoshop"			' psd
	Case "image/bmp"				' bmp
	Case "image/x-emf"				' emf
	Case "image/gif"				' gif
	Case "image/png"				' png
	Case "image/x-eps"				' eps
	Case "image/x-dxf"				' dxf
	Case "image/x-met"				' jpg ?
	Case "image/x-pcx"				' pcx
	Case "image/x-sgf"				' sgf
	Case "image/x-sgv"				' sgv
	Case "image/x-svm"				' svm
	Case "image/x-wmf"				' wmf
	Case "image/x-vclgraphic"			' parfois jpg  
	End Select

A noter que pour l'image en pièce-jointe, à l'analyse le type mime est
x-vclgraphic en OOo 3.2.1 et la macro plante puisqu'il n'y a pas de gestion d'erreur à proprement parler.
image/jpeg en LO 3.4.2 et la macro ne plante pas

[webber]

Salut,

Sous XP, la macro de Dude fonctionne. Sous Vista, ça ne fonctionne pas. Pourtant, c'est la même version d'OpenOffice 3.3.
Sous Vista, j'avais les problèmes de Mime évoqués par Churay, du coup, j'ai complété le programme. Voici ce que ça donne :

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 repertoire As string
	repertoire = "C:\Temp" ' Modifier le chemin si Linux
	
	Dim monDocument As Object, oExp      As object
	Dim oImages     As Object, oImage    As Object
	Dim sImageUrl   As string, sImageExt As string
	Dim sImage      As string, mData()   As variant
	Dim oFic        As Object 
	Dim extensionFichier As String
		
	monDocument = ThisComponent
	
	oImages = monDocument.GraphicObjects
	
	' Prendre la 1ere image intégrée (index à zéro)
	oImage = oImages(1)
	
	' Extraire son nom
	sImageUrl = Mid (oImage.GraphicURL, 28)
		
	' Quel est le type de l'image 
   Select case oImage.Graphic.MimeType
   Case "image/jpeg", "image/jpg"  
   	extensionFichier = "jpg"
   Case "image/tiff", "image/tif"   
   	extensionFichier = "tiff"
   Case "image/x-photo-cd" 
   	extensionFichier = "pcd"
   Case "image/x-xpixmap"        
   	extensionFichier = "xpm"
   Case "image/x-xbitmap"       
   	extensionFichier = "xbm"
   Case "image/x-portable-bitmap", "image/x-portable-graymap", _
   		"image/x-portable-pixmap"
   	extensionFichier = "pgm"
   Case "image/x-pict"
   	extensionFichier = "pict"
   Case "image/x-cmu-raster"
   	extensionFichier = "ras"
   Case "image/x-targa"
   	extensionFichier = "tga"
   Case "image/x-photoshop"
   	extensionFichier = "psd"
   Case "image/bmp"
   	extensionFichier = "bmp"
   Case "image/x-emf" 
   	extensionFichier = "emf"
   Case "image/gif"
   	extensionFichier = "gif"
   Case "image/png"
   	extensionFichier = "png"
   Case "image/x-eps" 
   	extensionFichier = "eps"
   Case "image/x-dxf" 
   	extensionFichier = "dxf"
   Case "image/x-met"
   	extensionFichier = "jpg"
   Case "image/x-pcx"
   	extensionFichier = "pcx"
   Case "image/x-sgf" 
   	extensionFichier = "sgf"
   Case "image/x-sgv"  
   	extensionFichier = "sgv"
   Case "image/x-svm"
   	extensionFichier = "svm"
   Case "image/x-wmf"
   	extensionFichier = "wmf"
   Case "image/x-vclgraphic" 
   	extensionFichier = "jpg"
   Case Else
   	msgbox( "MimeType inconue : " &  oImage.Graphic.MimeType )
   	exit Sub
   End Select
 		
	' Ce qui donne le nom comlet
	sImage = sImageUrl & "." & extensionFichier
	
	msgbox(sImage)
	
	' Extraction du fichier dans un flux binaire
	oFic  = monDocument.DocumentStorage.getByName("Pictures").getByName(sImage)
	oFlux = oFic.InputStream
	oURL  = ConvertToUrl( repertoire & "\"  & sImage)
	
	
	' 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 

J'obtiens le message d'erreur suivant :

Erreur d'exécution BASIC.
Une exception s'est produite :
Type: com.sun.star.container.NoSuchElementException
Message:O:/OOO330/ooo/package/source/xstor/xstorage.cxx: :4347;.

Ligne de code incriminée :

Code : Tout sélectionner

oFic  = monDocument.DocumentStorage.getByName("Pictures").getByName(sImage)

Voilà !! Une idée ?

[Dude]

Voilà !! Une idée ?

Comment veux-tu que l'on sache ce que contient sImage ?
Tu as interrogé l'objet avec XRay pour voir ?

Sous Vista, ça ne fonctionne pas.

Même Microsoft reconnait que Vista est une bouse. Mets toi à jour avec Win7.

[Churay]

[HS=ON]
Rhoooôôôôoooo....

Même Microsoft reconnait que Vista est une bouse. Mets toi à jour avec Win7.

Et voilà comment on se fait taxer de parti pris ou de troller... Il faut citer...

Steve Balmer (CEO de Microsoft), mai 2006 : Windows Vista, sera invulnérable.

Le même Balmer, mai 2011 : Vista était une erreur de parcours.
(h**p://www.microsoft.com/presspass/events/ceos ... entListTop)

Rien de nouveau en fait, Millenium était déjà une aberration chromosomique (adorant les cas d'école, je dois confesser que j'avais bien aimé ce truc)
[HS=OFF]
Voir l'intervention de bm en section Suprêmes : simplification et fiabilité.
Merci Bernard

[webber]

Salut,

Je veux bien vous croire, mais pour l'instant je dois faire ainsi avec Vista et je ne serai pas le seul à utiliser cette macro sous Vista .
Sinon, pour la macro, bah je ne comprends pas trop. Si j'exécute l'ODT fournit ci-dessus, ça fonctionne. Si j'insère une image et la relance, ça ne fonctionne plus. Si j'utilise cette macro dans un autre document, ça ne fonctionne pas, du moins c'est aléatoire.

Mais je pense avoir cerné les soucis, mais j'aurais besoin de votre aide :

Depuis que je me suis lancé dans l'apprentissage de OOoBasic, j'ai pris l'habitude d'utiliser systématiquement Option Explicit. De ce fait, dans la macro, il y avait des variables non définies et j'ai corrigé. Est-ce une bonne façon de travailler ?
Ensuite, je viens de remarquer un détail qui me chagrine. Dans un document ODT, lorsque l'on supprime une image du document, ce dernier n'est en fait pas du tout supprimé du répertoire Pictures, du coup, la macro la récupère toujours. J'ai fait un test en enregistrant un fichier puis en dé-zippant l'ODT, j'ai trouvé des images qui avaient été supprimées.
Quel est la moyen, si c'est possible, de réellement supprimer l'image , cela peu avoir un impact dans la taille du document ?
Le dernier souci est la problématique des mimes. Comment détecter le bon car malgré le code de Churay, j'ai toujours des erreurs de casting lorsque j'obtiens un image/x-vclgraphic si la macro la correspond à png alors que l'image est du jpg, bah ça plante.

Concernant Xray, je ne connais pas, dans la bible d'OpenOffice il explique comment utiliser OOoBasic, donc je ne sais pas par quoi commencer pour tester Xray.

Merci !

[Churay]

Bonjour,

D'ores et déjà :

j'ai pris l'habitude d'utiliser systématiquement Option Explicit. De ce fait, dans la macro, il y avait des variables non définies et j'ai corrigé. Est-ce une bonne façon de travailler ?

AMHA, l'Option Explicit est un bon réflexe, mais ce n'est que mon avis.

Pour le reste, je bricole une petite heure sur la voiture et je reviens.

[webber]

Le bricolage de la voiture a pris du temps, j'espère qu'elle roule tout de même .
Sinon j'ai installé X-ray mais je n'ai toujours rien trouvé. je continue à chercher, merci d'avance !

[Churay]

Bonjour

Le bricolage de la voiture a pris du temps, j'espère qu'elle roule tout de même .

Plus que prévu... mais elle a redémarré

Donc un mix : approche de Dude + intervention de bm + mon interprétation

Code : Tout sélectionner

Option Explicit

Sub Adr_images
Dim oForm As Object, oGraph As Object
Dim sDirCible As String, sPath As String
Dim sImageUrl As String, sImageOut As String
Dim sRet As String, nRet As Integer, Fics
Dim i As Integer, j As Integer

	Do
		sDirCible = InputBox("Veuiller saisir le chemin complet","Dossier d'enregistrement") 
		' une annulation possible
		IF UCase(sDirCible) = "FIN" Then exit sub
		' Si rien n'a été saisi -> un dossier par défaut
		IF Len(sDirCible) = 0 Then sDirCible = "C:\Temp\webber\"
		' Test de cohérence (partiel) d'un nom de fichier Windows
		IF Right(sDirCible,1) <> "\" Then sDirCible = sDirCible & "\"
		IF Mid(sDirCible,2,1) = ":" AND Mid(sDirCible,3,1) = "\" Then
			nRet = MsgBox ( sDirCible , 4, "Confirmation de chemin ") 
		else 
			MsgBox "Chemin incorrect", 16, "Attention"
		End IF
	Loop Until nRet = 6
	' Si le dossier n'existe pas, on le crée
	sRet = Dir(sDirCible ,16) : If sRet = "" Then mkDir(sDirCible )

	' On Boucle sur les images du documents
	oForm = thisComponent.GraphicObjects
	For i = 0 To oForm.Count - 1
		oGraph  = oForm(i)
		IF oGraph.Graphic.MimeType <> "image/x-vclgraphic " then
			' Nom sans extension
			sImageUrl = Mid (oGraph.GraphicURL, 28)
			Fics = thisComponent.DocumentStorage.getByName("Pictures")

			' Nom avec extension
			For j = 0 TO UBound(Fics.ElementNames)
				If sImageUrl = Left(Fics.ElementNames(j),Len(Fics.ElementNames(j))-4) Then
					sImageOut = Fics.ElementNames(j): Exit For
				End if
			Next j
			Save_Image(oGraph, sDirCible , sImageOut)
		Endif
	Next i
	thisComponent.Store
End Sub


Sub Save_Image(oGraph, sRep, sImageOut)
   ' ********************************************************************************
   ' Compactage de 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 sImageUrl as string
Dim oFic as Object, oExp as object, sURL As String
	sImageUrl = oGraph.GraphicURL 'Mid (oGraph.GraphicURL, 28)

On error goto Ooops
	oFic = thisComponent.DocumentStorage.getByName("Pictures").getByName(sImageOut)
	sURL = ConvertToUrl(sRep & sImageOut)
   ' Export dans le fichier
	oExp = CreateUnoService("com.sun.star.ucb.SimpleFileAccess")
	oExp.writeFile(sURL, oFic)

	Goto No_Ooops
Ooops:
	MsgBox chr(13) + sImageUrl + chr(13) + sImageOut , 16 ,"Une erreur s'est produite"
'	XRay OGraph
No_Ooops:
End sub 

Ajout : Effectivement : quand on ajoute une image, il peut y avoir un pb D'où le rajout du traitement d'erreur qui évite le plantage, mais qui n'affiche pas nécessairement le message

[webber]

Merci,
content pour ta voiture .
Sinon je vais creuser ton code pour en faire bon usage au mieux que possible.

[Churay]

Bonsoir

Sinon je vais creuser ton code

Euhhhh....

approche de Dude + intervention de bm + mon interprétation

Interprétation, repiquage et adaptation tout au plus

[webber]

Il y a un comportement que je ne comprends pas. J'essaye de clarifier le code afin de le rajouter par la suite dans une de mes extensions.
Mais pour un raison que j'ignore, j'ai maintenant ce message d'erreur sur la ligne suivante :

Code : Tout sélectionner

Option Explicit

Sub exporter_images

	Dim oForm 		As Object, oGraph 	 As Object
	Dim cheminRepertoire 	As String, sPath 	 As String
	Dim sImageUrl 	As String, sImageOut As String
	Dim sRet 		As String, validiteRepertoire 	 As Integer, Fics
	Dim compteurImages 			As Integer, j 		 As Integer
	Dim monDocument   As Object	

        ' Le document courant
	monDocument     = ThisComponent
	xray monDocument

Erreur d'exécution Basic
Sous-procédure ou procédure de fonction non définie

Qu'ai -je fais de mal ?

monDocument doit normalement être le document sur lequel j'appelle la macro, pourquoi est-il non définie ?

Merci !

[Alain de La Chaume]

Bonjour,

Dans le mode d'emploi pour Xray il est dit :

Si la ligne de code Xray déclenche une erreur d’exécution,
c’est que la bibliothèque n’est pas chargée ; lisez les sections 3.1.1 et 3.1.2.

Bien cordialement, Alain

[webber]

Ok, merci. Cela m'a permit de charger Xray automatiquement.

Maintenant, j'ai ce message d'erreur sur cette ligne :

Code : Tout sélectionner

Fics = monDocument.DocumentStorage.getByName("Pictures")

Erreur d'exécution BASIC.
Une exception s'est produite :
Type: com.sun.star.container.NoSuchElementException
Message: O:/OOO330/ooo/package/source/Xstor/Xstorage.cxx: :4347; .

Voilà, pourtant, dans les lignes précédente, j'avait bien l'url de l'image, le nom de l'image, le type...

Voilà la procédure complète :

Code : Tout sélectionner

Sub exporter_images

	Dim oForm 		As Object, oGraph 	 As Object
	Dim cheminRepertoire 	As String, sPath 	 As String
	Dim sImageUrl 	As String, sImageOut As String
	Dim sRet 		As String, validiteRepertoire 	 As Integer, Fics
	Dim compteurImages 			As Integer, j 		 As Integer
	Dim monDocument   As Object
	
	' Le document courant
	monDocument     = ThisComponent

	Do
		' Sélection du répertoire
		cheminRepertoire = InputBox("Veuiller saisir le chemin complet","Dossier d'enregistrement") 
				
		' Si rien n'a été saisi -> un dossier par défaut
		IF Len(cheminRepertoire) = 0 Then cheminRepertoire = "C:\Temp\webber\"
		
		' Test de cohérence (partiel) d'un nom de fichier Windows
		IF Right(cheminRepertoire,1) <> "\" Then cheminRepertoire = cheminRepertoire & "\"
		IF Mid(cheminRepertoire,2,1) = ":" AND Mid(cheminRepertoire,3,1) = "\" Then
			validiteRepertoire = MsgBox ( cheminRepertoire , 4, "Confirmation de chemin ") 
		else 
			MsgBox "Chemin incorrect", 16, "Attention"
		End IF
		
	' On boucle jusqu'à ce que l'on clique sur OUI	
	Loop Until validiteRepertoire = 6
	
	' Si le dossier n'existe pas, on le crée. 
	' 16 veut dire que la fonction Dir retourne le nom du répertoire (ou fichier)
	sRet = Dir(cheminRepertoire ,16) : If sRet = "" Then mkDir(cheminRepertoire )

	' On Boucle sur les images du document
	oForm = monDocument.GraphicObjects
	
	For compteurImages = 0 To oForm.Count - 1
		oGraph  = oForm(compteurImages)
		
		msgbox( "Nom de l'image : " & oGraph.Name )
		msgbox( "MimeType de l'image : " & oGraph.Graphic.MimeType )
		msgbox( "URL de l'image : " & oGraph.GraphicURL )
		
		IF oGraph.Graphic.MimeType <> "image/x-vclgraphic " then
			
			' Nom sans extension
			sImageUrl = Mid (oGraph.GraphicURL, 28)
			
			msgbox( "Nom URL sans l'extension de l'image" & sImageUrl )

			xray monDocument

			Fics = monDocument.DocumentStorage.getByName("Pictures")
			
			xray Fics
			
			' Nom avec extension
			For j = 0 TO UBound(Fics.ElementNames)
				If sImageUrl = Left(Fics.ElementNames(j),Len(Fics.ElementNames(j))-4) Then
					sImageOut = Fics.ElementNames(j): Exit For
				End if
			Next j
			Save_Image(oGraph, cheminRepertoire , sImageOut)
		Endif
	Next compteurImages
	monDocument.Store
End Sub

[Bidouille]

En plus du code, fournissez avec un fichier complet. Cela augmentera vos chances de réponse en évitant d'avoir à recréer quelque chose qui au final, pourrait ne pas convenir.

N'oubliez pas que vous devez faciliter la tâche des bénévoles qui vous consacrent du temps.

[Churay]

Bonjour,

Sous XP, il arrive que certaines images provoque une erreur, pour éviter le plantage :

Ajout : Effectivement : quand on ajoute une image, il peut y avoir un pb D'où le rajout du traitement d'erreur qui évite le plantage, mais qui n'affiche pas nécessairement le message

Pour tester, il faudrait ton fichier avec tes images (au moins une ou deux qui ne posent pas pb et des images qui en posent...)

[webber]

Ok, je vais essayer de faire un fichier séparé avec des images pour reproduire les bugs.
Merci pour le temps que vous consacrez à m'aider.