Traitement d'images dans un fichier word

Résolu
momouiz Messages postés 30 Date d'inscription   Statut Membre Dernière intervention   -  
momouiz Messages postés 30 Date d'inscription   Statut Membre Dernière intervention   -
Hello la communauté ccm, voila aprés avoir passé énormément de temps, à chercher une solution pour extraire les images contenus dans un fichier word j'ai essayé ceci:

Private Sub Convertit_en_zip()
Dim Objetword As Word.Application
Dim docword As Word.document

Dim Chemin As String
Dim Fichier As String
Dim LeNom As String

Set Objetword = CreateObject("Word.application")

Fichier = Application.GetOpenFilename("Text Files (*.doc), *.doc")
Set docword = Objetword.Documents.Open(Fichier)
Objetword.Visible = False

MsgBox (Fichier)

While Right(Fichier, 1) <> "\"
LeNom = Right(Fichier, 1) & LeNom
Fichier = Left(Fichier, Len(Fichier) - 1)
Wend
MsgBox (docword.SaveFormat)
Chemin = "C:\Documents and Settings\mslimani060313\Desktop"

LeNom = Left(LeNom, Len(LeNom) - 3) & "odt" ' le nom avec xls
MsgBox (LeNom)
If docword.SaveFormat = 13 Then
Application.Dialogs.Item(xlDialogSaveAs).Show LeNom

End If

End Sub


en gros mon programme convertis mon fichier en .zip, enfin u_u' ce que je voulais faire, mais lorsque j'ouvre mon fichier ce dernier ne s'ouvre pas,

y a t-il un autre moyen pour traiter les images d'un document word ?


A voir également:

1 réponse

Réponse 1 / 1
momouiz Messages postés 30 Date d'inscription   Statut Membre Dernière intervention   3
 
Dim sFile As String, sFolder As String


sFolder = "C:\Documents and Settings\mslimani060313\Desktop\Tests\"
sFile = Dir(sFolder & "*.doc")

If sFile = "" Then

MsgBox "Il n'y a aucun fichier LS0 dans ce folder"

Else

Do While Not sFile = ""

Name sFolder & sFile As sFolder & Left(sFile, Len(sFile) - 3) & "zip"

sFile = Dir()
Loop
End If


End Sub
Sub TestRun_unzip()

Call unzip("C:\Documents and Settings\mslimani060313\Desktop\Tests", "C:\Documents and Settings\mslimani060313\Desktop\Tests\2-FunctionalSpecification v2.7.zip")

End Sub


Private Sub unzip(strTargetPath As String, Fname As Variant)

Dim oApp As Object
Dim FileNameFolder As Variant


If Right(strTargetPath, 1) <> Application.PathSeparator Then

strTargetPath = strTargetPath & Application.PathSeparator
End If

FileNameFolder = strTargetPath

Set oApp = CreateObject("Shell.Application")
oApp.Namespace(FileNameFolder).Copyhere oApp.Namespace(Fname).items
1