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+unsubscribe@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