I am trying to replace an existing image (a external image) with another one but I can´t modify the image property Graphic.OriginURL
Ok @rodri , show the code (or better, a document with the code and an example image) - let’s try to figure out which of the lines of the macro needs to be corrected.
Sub macrorReplaceImage
Dim oDoct As Object, docProperties()
Dim sUrl, sImageFile, sImageURL As String
Dim oExistingGraph As Object
sUrl = convertToURL(“C:\Varios\Libtest\Doc1.odt”)
sImageFile = “C:\Varios\Libtest\italy.png”
sImageURL = convertToURL(sImageFile)
if fileExists(sUrl) then
oDoct = stardesktop.LoadComponentFromURL(sUrl, “_blank”,0, docProperties())
else
msgbox “Not found”
end if
oDP = oDoct.getGraphicObjects()
oExistingGraph = oDP.getbyIndex(0)
Print oExistingGraph.Graphic.OriginURL
oExistingGraph.Graphic.OriginURL = sImageURL
End Sub
Doc1.odt (9.4 KB)
The image´s url is correctly read but it fails at the last line because OriginURL is read-only
Change last line in your macro:
oExistingGraph.GraphicURL = sImageURL
That solved it, thans
Hello KamilLanda and rodri,
I tried your example and the Graphic is changed but,
the Graphic is not linked it is embedded.
How do I set it as linked?
Best Regards
Wolfgang
Hello Wolfgang, I discovered the insertion only via the macro from Macro Recorder.
But I suppose the best solution could be to detect the properties of replaced image (like Anchor Type and Vertical Orientation), and set these properties to new image - but this detection isn’t in example.
Sub insertImageAsLink
dim oDoc as object, document as object, dispatcher as object, sUrl$, oSel as object, oSize as new com.sun.star.awt.Size
sUrl=ConvertToUrl("d:\opti.png") 'your image
oDoc=ThisComponent
document=oDoc.CurrentController.Frame
dispatcher=createUnoService("com.sun.star.frame.DispatchHelper")
dim args1(3) as new com.sun.star.beans.PropertyValue
args1(0).Name="FileName"
args1(0).Value=sUrl
args1(1).Name="FilterName"
args1(1).Value="<All images>"
args1(2).Name="AsLink"
args1(2).Value=true
args1(3).Name="Style"
args1(3).Value="Graphics"
dispatcher.executeDispatch(document, ".uno:InsertGraphic", "", 0, args1() )
rem inserted image is selected, so you you can change the properties of one
oSel=oDoc.CurrentController.Selection 'inserted image
with oSel
.AnchorType=com.sun.star.text.TextContentAnchorType.AS_CHARACTER
.VertOrient=com.sun.star.text.VertOrientation.CHAR_CENTER
end with
oSize=oSel.ActualSize
with oSize 'simulate the proper DPI of inserted image
.Width=2/3*.Width
.Height=2/3*.Height
end with
oSel.Size=oSize
End Sub
If you will have the problem with replacement, upload some example ODT for testing.
Hello KamilLanda,
thank you for your example. Is it possible to suppress the messagebox that appears in your
code?
attached you will find a short Document and the linked Pictures.
I stored it at C:\temp\TestPictureReplacementa and the pictures in
C:\temp\TestPictureReplacement\res.
This Document has “German”-Pictures and I have to replace them
with die Englisch or other Languaes ones. The Real Dokument needs
more then 100 replacements.
With the following code the replacement works, but the Pictures get
embedded.
Test_Picture_Libreoffice.odt (13.9 KB)
Sub lsErsetzeSprache()
Dim oLSDrawPage As Object
Dim intLSDPCount As Integer
dim strLSURL as string
dim strLSSpracheAlt as string
dim strLSSpracheNeu as string
strLSSpracheAlt=inputbox("Bisherige Sprache (DE/EN...):", "Bisherige Warnhinweise","DE")
strLSSpracheAlt="_" & ucase(strLSSpracheAlt) & "_"
strLSSpracheNeu=inputbox("Neue Sprache (DE/EN...):", "Neu Sprache Warnhinweise","EN")
strLSSpracheNeu="_" & ucase(strLSSpracheNeu) & "_"
oLSDrawPage = ThisComponent.DrawPage()
intLSDPCount = oLSDrawPage.Count
For intLSi = 0 To intLSDPCount - 1
oGraph = oLSDrawPage(intLSi)
if oGraph.getImplementationName()="SwXTextGraphicObject" then
if instr(oGraph.Graphic.OriginURL,strLSSpracheAlt) >0 then
oGraph.GraphicURL =replace(oGraph.Graphic.OriginURL,strLSSpracheAlt,strLSSpracheNeu)
end if
end if
Next
msgbox "Fertig!"
End Sub
Best Regards
Wolfgang
Sub lsErsetzeSprache()
Dim oLSDrawPage As Object
Dim intLSDPCount As Integer
dim strLSURL as string
dim strLSSpracheAlt as string
dim strLSSpracheNeu as string
dim oDoc as object, iAnchor%, iVert%, oStatusbar as object, args1(1) as new com.sun.star.beans.PropertyValue, oImg as object, document as object, dispatcher as object
args1(0).Name="FileName"
args1(1).Name="AsLink" : args1(1).Value=true
oDoc=ThisComponent
document=oDoc.CurrentController.Frame
dispatcher=createUnoService("com.sun.star.frame.DispatchHelper")
strLSSpracheAlt=inputbox("Bisherige Sprache (DE/EN...):", "Bisherige Warnhinweise","DE")
strLSSpracheAlt="_" & ucase(strLSSpracheAlt) & "_"
strLSSpracheNeu=inputbox("Neue Sprache (DE/EN...):", "Neu Sprache Warnhinweise","EN")
strLSSpracheNeu="_" & ucase(strLSSpracheNeu) & "_"
oLSDrawPage = oDoc.DrawPage()
intLSDPCount = oLSDrawPage.Count
oStatusbar=oDoc.CurrentController.StatusIndicator 'progress in statusbar
oStatusbar.Value=1
oStatusbar.Start("replacement", intLSDPCount)
For intLSi = 0 To intLSDPCount - 1
oGraph = oLSDrawPage(intLSi)
if oGraph.getImplementationName()="SwXTextGraphicObject" then
if instr(oGraph.Graphic.OriginURL,strLSSpracheAlt) >0 then
oDoc.CurrentController.select(oGraph) 'select current image
iAnchor=oGraph.AnchorType : iVert=oGraph.VertOrient 'remember the properties of image
wait 10 'for sure because there was selection
args1(0).Value=replace(oGraph.Graphic.OriginURL,strLSSpracheAlt,strLSSpracheNeu)
dispatcher.executeDispatch(document, ".uno:InsertGraphic", "", 0, args1 ) 'insert new image as link instead of old image
wait 10 'for sure because there was uno:command
oImg=oDoc.CurrentController.Selection
with oImg 'update the properties of new image
.AnchorType=iAnchor
.VertOrient=iVertOrient
end with
end if
end if
if intLSi MOD 5 = 0 then oStatusbar.Value=intLSi 'update statusbar
Next
oStatusbar.end : oStatusbar.reset
dispatcher.executeDispatch(document, ".uno:Escape", "", 0, array() ) 'deselect last inserted image
msgbox "Fertig!"
End Sub
And uncheck the checkbox in messagebox for uninterrupted inserting
1 Like
Hello KamilLanda,
thank you very much, it works!
It will save me a lot of time.
Best Regards
Wolfgang