|
Hallo,
ich habe unter Word2016 einen anderen Ansatz erarbeitet:
So werden alle Bilder rausgeschrieben (nach *.tiff konvertieren kann ich nicht).
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 | Sub Idee()
Dim objXML As MSXML2.DOMDocument
Dim objNode As MSXML2.IXMLDOMElement
Dim InlSh As InlineShape
Dim Filename As String, ff As Integer
Dim tmp() As Byte
Const Pfad As String = "c:\DeinPfad\mit\abschliessendem\Backslash\"
For Each InlSh In ThisDocument.InlineShapes
Set objXML = New MSXML2.DOMDocument
objXML.LoadXML InlSh.Range.WordOpenXML
Filename = objXML.getElementsByTagName("pic:cNvPr").Item(0).Attributes(1).Text
Set objNode = objXML.createElement("b64")
objNode.dataType = "bin.base64"
objNode.Text = objXML.getElementsByTagName("pkg:binaryData").Item(0).Text
tmp = objNode.nodeTypedValue
ff = FreeFile()
Open Pfad & Filename For Binary As #ff
Put #ff, , tmp
Close #ff
Next
Set objXML = Nothing
Set objNode = Nothing
End Sub
|
Bei meinen Tests kamen die *.png, *.jpg und *.tiff genau so raus, wie die Originale waren bevor ich sie in das Worddokument eingefügt habe (auf das bit genau).
Ausnahme: *.bmp wurde Wordintern irgendwie nach png konvertiert. Dementsprechend kam es auch verändert raus und hat die falsche Dateiendung?! Dem bin ich nicht weiter nachgegangen.
In Word2016 werden die Bilder standardmäßig komprimiert, das muss natürlich abgeschaltet sein, damit die extrahierten Bilder mit den originalen identisch sind (klar, sind die Bilder erst einmal komprimiert, kann man das nicht rückgängig machen).
Evtl. kann man da auch einstellen, dass das mit bmp nicht passiert => nicht im Kern meines Interesses.
Der Code ist als experimentell anzusehen. Es ist das erste Mal, dass ich mit dieser XML-dll arbeite. Keine Ahnung, ob ich da grundsätzliche Fehler gemacht habe, es war mehr so "spielerisches forschen".
Auch sind keine Abfragen drin, die ein Überschreiben vorhandener Dateien verhindern würden (Achtung, da hat man schnell mal ein Original mit was kompimiertem überschrieben). Daher bitte bei der Wahl des Pfades sorgfältig sein!
Da du ja nach selektieren und nur einem Bild gefragt hast, hier der gleiche Code, der aber nur das aktuell selektierte Bild exportiert.
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 | Sub selektiertesBildExportieren()
Dim objXML As MSXML2.DOMDocument
Dim objNode As MSXML2.IXMLDOMElement
Dim Filename As String, ff As Integer
Dim tmp() As Byte
Const Pfad As String = "c:\DeinPfad\mit\abschliessendem\Backslash\"
Set objXML = New MSXML2.DOMDocument
objXML.LoadXML Selection.WordOpenXML
Filename = objXML.getElementsByTagName("pic:cNvPr").Item(0).Attributes(1).Text
Set objNode = objXML.createElement("b64")
objNode.dataType = "bin.base64"
objNode.Text = objXML.getElementsByTagName("pkg:binaryData").Item(0).Text
tmp = objNode.nodeTypedValue
ff = FreeFile()
Open Pfad & Filename For Binary As #ff
Put #ff, , tmp
Close #ff
Set objXML = Nothing
Set objNode = Nothing
End Sub
|
Bei beiden Codes ist ein Verweis auf "Microsoft XML v3.0" nötig. Höhere Versionen gehen bestimmt auch, ich habe einfach mal die 3.0 benutzt ...
Grüße, Ulrich
|