von JanekUseless » Di, 31.10.2006 13:42
Hallo OOo-User,
ich habe folgendes Problem:
Ich habe ein Makro geschrieben, dass ein OOo-Textdokument in Wiki-format übersetzt und den erzeugten Quellcode in die Zwischenablage kopiert. Soweit so gut. Jetzt habe ich die Grafiken aus dem Dokument mit dem folgenden CodeSnippet ausgelesen:
Code: Alles auswählen
OPTION EXPLICIT
Sub ExtractWriterGraphics
On Local Error Goto ErrorHandler
Dim oDocument as Object
Dim oGraphics as Object
Dim oZipArchive as New com.sun.star.packages.Package
Dim oPictures as Object
Dim mZipFile(0) as Variant
Dim mFiles() as String
Dim oFileAccess as New com.sun.star.ucb.SimpleFileAccess
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
oDocument = StarDesktop.getCurrentComponent
' create destination folder relative to document ...
oTransformer = createUnoService("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("com.sun.star.packages.Package")
mZipFile(0) = oDocument.URL
oZipArchive.initialize(mZipFile())
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()
Exit Sub
ErrorHandler:
MsgBox "Error: " & Err() & " " & Error() & " " & Erl()
End Sub
funktioniert auch ganz prima, solange die Bilder mit Einfügen->Bild->Aus Datei eingefügt werden. Wenn ich nun allerdings, und das ist der ganze Sinn der Sache, Bilder per Copy/Paste einfüge, dann erhalte ich die Bilder im .svm Format. Damit kann ich aber nichts anfagen. Gibt es eine Möglichkeit die Bilder intern in einem anderen Format abzulegen, oder ein Makro, dass die Bilder von mir aus neu lädt und dann in ein anderes Format konvertiert.
Danke schon mal. Ist wirklich dringend!
Hallo OOo-User,
ich habe folgendes Problem:
Ich habe ein Makro geschrieben, dass ein OOo-Textdokument in Wiki-format übersetzt und den erzeugten Quellcode in die Zwischenablage kopiert. Soweit so gut. Jetzt habe ich die Grafiken aus dem Dokument mit dem folgenden CodeSnippet ausgelesen:
[code]
OPTION EXPLICIT
Sub ExtractWriterGraphics
On Local Error Goto ErrorHandler
Dim oDocument as Object
Dim oGraphics as Object
Dim oZipArchive as New com.sun.star.packages.Package
Dim oPictures as Object
Dim mZipFile(0) as Variant
Dim mFiles() as String
Dim oFileAccess as New com.sun.star.ucb.SimpleFileAccess
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
oDocument = StarDesktop.getCurrentComponent
' create destination folder relative to document ...
oTransformer = createUnoService("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("com.sun.star.packages.Package")
mZipFile(0) = oDocument.URL
oZipArchive.initialize(mZipFile())
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()
Exit Sub
ErrorHandler:
MsgBox "Error: " & Err() & " " & Error() & " " & Erl()
End Sub
[/code]
funktioniert auch ganz prima, solange die Bilder mit Einfügen->Bild->Aus Datei eingefügt werden. Wenn ich nun allerdings, und das ist der ganze Sinn der Sache, Bilder per Copy/Paste einfüge, dann erhalte ich die Bilder im .svm Format. Damit kann ich aber nichts anfagen. Gibt es eine Möglichkeit die Bilder intern in einem anderen Format abzulegen, oder ein Makro, dass die Bilder von mir aus neu lädt und dann in ein anderes Format konvertiert.
Danke schon mal. Ist wirklich dringend!