Hallo Oliver,
das ist eine feines Makro :-)) ...
Dazu folgende Frage:
Du empfiehlst den Bildern vorher aussagekräftige Namen zu geben, weil
sie sonst Bild1, Bild2 ... genannt werden.
Heißt das, dass Dein Makro die in der content.xml vorhandenen Namen
(hier beispielsweise)
<draw:frame draw:style-name="fr1" draw:name="Bild48"
text:anchor-type="as-char" svg:width="15.004cm" svg:height="15.004cm"
draw:z-index="915">
<draw:image
xlink:href="Pictures/10000000000006EC000006EC21383865E727B20D.jpg"
xlink:type="simple" xlink:show="embed"
xlink:actuate="onLoad"/></draw:frame>
übernimmt oder erzeugst Du selbst neue Namen, wobei Du bei dem ersten
"draw:name" im WRITER-Dokument mit draw:name="Bild1" beginnst und dann
einfach hoch zählst ?
Gruß
Hans-Werner
------ Originalnachricht ------
Von: "Oliver Brinzing" <oliver.brinz...@gmx.de>
An: users@de.libreoffice.org
Gesendet: 02.08.2018 17:05:01
Betreff: Re: [de-users] Reste von gelöschten Fotos und Verlinkung
Hallo Ralf,
>die alle durch Verknüpfungen zu
> ersetzen. Kann man das evtl. automatisiert machen?
ich habe vor Jahren mal das unten angefügte Makro geschrieben, das
genau das macht.
Wenn Du es damit versuchst:
- Teste es nur mit einer Kopie(!) - wenn etwas beim Extrahieren nicht
funktionieren
sollte, dann ist das Dokument ziemlich sicher kaputt...
- Gib den Bildern im Dokument vorher aussagekräftige Namen, die
extrahierten
Bilddateien werden danach benannt, sonst hast Du Bild1, Bild2 etc.
- Das Makro vom geöffnetem Dokument aus starten.
Die Bilder liegen dann im Unterordner "Bilder"
Bei 200 Bildern dürfte das eine ganze Weile benötigen.
Gruß
Oliver
--
OPTION EXPLICIT
Sub Start()
Call ExtractWriterGraphics(ThisComponent, "Bilder")
MsgBox "Fertig"
End Sub
Function ExtractWriterGraphics(oDocument, ByVal sFolderName as String)
On Local Error Goto ErrorHandler
Dim oGraphics as Object
Dim oZipArchive as Object
Dim oPictures as Object
Dim mZipFile(0) as Variant
Dim mFiles() as String
Dim mFileProps(1) as New com.sun.star.beans.PropertyValue
Dim oFileAccess as Object
Dim oFile as Object
Dim oInputStream as Object
Dim oOutputStream as Object
Dim mData() as Variant
Dim sDestFolder as String
Dim sGraphicName as String
Dim sGraphicURL as String
Dim sTmp as String
Dim oUrl as New com.sun.star.util.URL
Dim oTransformer as Object
Dim n as Long
Dim i as Integer
Dim j as Integer
Dim k as Integer
' create destination folder relative to document ...
oTransformer = createUnoService("com.sun.star.util.URLTransformer")
oUrl.Complete = oDocument.URL
oTransformer.parsestrict(oUrl)
If sFolderName = "" Then
sFolderName = "Pictures"
EndIf
sDestfolder = "file://" & oURL.Path & sFolderName & "/"
' create backup...
oDocument.storeToURL(oURL.Complete + ".bak", mFileProps())
' open zip file and get content of "Pictures" folder ...
oZipArchive = createUnoService("com.sun.star.packages.Package")
mZipFile(0) = oDocument.URL
oZipArchive.initialize(mZipFile())
If Not oZipArchive.hasByHierarchicalName("Pictures") Then
ExtractWriterGraphics = -2
Exit Function
EndIf
oPictures = oZipArchive.getByHierarchicalName("Pictures")
oGraphics = oDocument.getGraphicObjects
' for all pictures in document ...
For i = 0 to oGraphics.getCount()-1
mFiles() = oPictures.getElementNames
sGraphicURL = oGraphics.getByIndex(i).GraphicURL
sTmp = sGraphicURL
' internal picture names start with "vnd.sun..."
If InStr(1, sGraphicURL, "vnd.sun.star.GraphicObject:", 0) = 1
Then
' get the picture name (comes without the extension)
sGraphicURL = Mid(sGraphicURL, 28, Len(sGraphicURL))
' so search all files in pictures folder for the
current picture ...
For j = 0 to uBound(mFiles())
If InStr(1, mFiles(j), sGraphicURL, 0) Then
' create new name with extension ...
sGraphicName = oGraphics.getByIndex(i).getName() & Mid(mFiles(j),
Len(sGraphicURL)+1, Len(mFiles(j))
Exit For
EndIf
Next j
' copy file to external folder relative to stored
document...
oFileAccess =
createUnoService("com.sun.star.ucb.SimpleFileAccess")
oFile = oFileAccess.openFileWrite(sDestFolder &
sGraphicName)
oOutputStream =
createUnoService("com.sun.star.io.DataOutputStream")
oOutputStream.setOutputStream(oFile)
oInputStream =
oPictures.getByName(mFiles(j)).getInputStream()
n = -1
While n <> 0
n = oInputStream.readBytes(mData(), 16384)
oOutputStream.writeBytes(mData())
Wend
oOutputStream.flush()
oOutputStream.closeOutput()
oInputStream.closeInput()
ReDim mData() as Variant
' now link picture to new external file ...
oGraphics.getByIndex(i).GraphicURL = sDestFolder &
sGraphicName
' check for duplicates, link them too ...
For k = i + 1 to oGraphics.getCount-1
If sTmp = oGraphics.getByIndex(k).GraphicURL
Then
oGraphics.getByIndex(k).GraphicURL =
sDestFolder & sGraphicName
EndIf
Next k
EndIf
Next i
' this automatically removes the unused internal pictures too :-)
oDocument.store()
ExtractWriterGraphics = 0
Exit Function
ErrorHandler:
ExtractWriterGraphics = -1
End Function
-- Liste abmelden mit E-Mail an: users+unsubscr...@de.libreoffice.org
Probleme?
https://de.libreoffice.org/hilfe-kontakt/mailing-listen/abmeldung-liste/
Tipps zu Listenmails: https://wiki.documentfoundation.org/Netiquette/de
Listenarchiv: https://listarchives.libreoffice.org/de/users/
Datenschutzerklärung: https://www.documentfoundation.org/privacy
--
Liste abmelden mit E-Mail an: users+unsubscr...@de.libreoffice.org
Probleme?
https://de.libreoffice.org/hilfe-kontakt/mailing-listen/abmeldung-liste/
Tipps zu Listenmails: https://wiki.documentfoundation.org/Netiquette/de
Listenarchiv: https://listarchives.libreoffice.org/de/users/
Datenschutzerklärung: https://www.documentfoundation.org/privacy
