Hi,
Oliver Brinzing asked me to update a code-snippet because he
found two small
bugs in the declaration section of the source code.
Here is the updated code-snippet.
I would like to remember that all the recent versions of the
code-snippet
creator can load and modify existing xml code snippets, so
if you want to
update/fix an existing code-snippet it's very easy:
you have only to download the xml source from the snippet
repository and then
open it by the snippet-creator wizard.
In effect, this is what I've just done with the attached
code-snippet. 
Thank you Oliver.
best regards
Paolo M
<?xml version="1.0"?>
<!--
$RCSfile: $
last change: $Revision: $ $Author: $ $Date: $
(c)2003 by the copyright holders listed with the
author-tags.
If no explicit copyright holder is mentioned with a certain
author,
the author him-/herself is the copyright holder. All rights
reserved.
Public Documentation License Notice:
The contents of this Documentation are subject to the
Public Documentation License Version 1.0 (the
"License");
you may only use this Documentation if you comply with
the terms of this License. A copy of the License is
available at http://ww
w.openoffice.org/licenses/PDL.html
The Original Documentation can be found in the CVS archives
of openoffice.org at the place specified by RCSfile: in this
header.
The Initial Writer(s) of the Original Documentation are
listed
with the author-tags below.
The Contributor(s) are listed with the author-tags below
without the marker for being an initial author.
All Rights Reserved.
-->
<snippet language="OOBasic"
application="Writer">
<keywords>
<keyword>writer</keyword>
<keyword>pictures</keyword>
<keyword>graphics</keyword>
<keyword>extract</keyword>
<keyword>link</keyword>
</keywords>
<authors>
<author id="paolomantovani"
initial="false" email="paolomantovani openoffice.org">Paolo
Mantovani</author>
<author id="OB" initial="true"
email="OliverBrinzingt-online.de">Oliver Brinzing</author>
</authors>
<question heading="extract graphics out of an
existing writer document">
How to extract graphics out of an existing writer document ?
<p>Having a writer document with lots of graphics
inside the "*.sxw" file is very </p>
<p>difficult to handle (e.g. it takes ages to save
...).</p>
</question>
<answer>
<p>Run the macro provided. It will extract all
graphics from an existing writer document</p>
<p>and place them in a folder
"/Pictures" relative to the writer
document. All pictures</p>
<p>will be renamed to the internal graphics name and
linked to the writer document. </p>
<p>After that the pictures folder inside the
"*.sxw" file will be removed.</p>
<p></p>
<p>Place the macro into the "user"
application container (e.g.
soffice-&Standard-&Module1)</p>
<p>Open the writer document you want
"refactor" and run the macro.</p>
<p>Remember: Always try this with a copy of your work
!</p>
<p></p>
<p>Don't forget to check if "Save
URLs relative to File system" in in Tools
-></p>
<p>Options -> Load/Save -> General is
enabled.</p>
<p></p>
<listing>
OPTION EXPLICIT
Sub ExtractWriterGraphics
On Local Error Goto ErrorHandler
Dim oDocument as Object
Dim oGraphics as Object
Dim oZipArchive as Object
Dim oPictures as Object
Dim mZipFile(0) as Variant
Dim mFiles() as String
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 {see 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
oDocument = StarDesktop.getCurrentComponent
' create destination folder relative to document
...
oTransformer = createUnoService("{see
com.sun.star.util.URLTransformer}")
oUrl.Complete = oDocument.URL
oTransformer.parsestrict(oUrl)
sDestfolder = "file://" &
oURL.Path & "Pictures/"
' open zip file and get content of
"Pictures" folder ...
oZipArchive = createUnoService("{see
com.sun.star.packages.Package}")
mZipFile(0) = oDocument.URL
oZipArchive.initialize(mZipFile())
oPictures =
oZipArchive.getByHierarchicalName("Pictures&quo
t;)
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("{see
com.sun.star.ucb.SimpleFileAccess}")
oFile = oFileAccess.openFileWrite(sDestFolder &
sGraphicName)
oOutputStream = createUnoService("{see
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()
Exit Sub
ErrorHandler:
MsgBox "Error: " & Err()
& " " & Error() &
" " & Erl()
End Sub
</listing>
</answer>
<versions>
<version number="1.0.x" status="can
not work"/>
<version number="1.1.x"
status="tested"/>
<version number="2.0.x"
status="tested"/>
</versions>
<operating-systems>
<operating-system name="All"/>
</operating-systems>
<changelog>
<change author-id="paolomantovani"
date="2006-03-31">Fixed two wrong
declarations</change>
<change author-id="OB"
date="2004-08-03">Initial
version</change>
</changelog>
</snippet>
------------------------------------------------------------
---------
To unsubscribe, e-mail: dev-unsubscribeapi.openoffice.org
For additional commands, e-mail: dev-helpapi.openoffice.org |