I looking for macro command to make a copy of shape between calc sheets.
I find interesting macro by @JohnSUN How to display image based on cell value
It is working only for pictures and unfortunately it is not working for shapes.
Please give me solution to make the same operation but with shapes.
Maxbert
A very raw piece of code. I would suppose that doing it without the dispatch helper is more complicated.
Sub copyShapesRawDemo(Optional pSourceSheet As Object, Optional pTargetSheet As Object, Optional pCondition)
REM The routine copies ALL the shapes from the drawpage of the source sheet to that of the target sheet.
REM A usable sub should find a way to restrict this under a condition.
REM Lots of complications to be expected.
theDoc = ThisComponent
theSheets = theDoc.Sheets
If IsMissing(pSourceSheet) Then pSourceSheet = theSheets(0)
If IsMissing(pTargetSheet) Then pTargetSheet = theSheets(1)
If pTargetSheet.Name=pSourceSheet.Name Then Exit Sub
If IsMissing(pCondition) Then pCondition = "All" REM Not evaluated!
cCtrl = theDoc.CurrentController
theFr = cCtrl.Frame
dispH = createUnoService("com.sun.star.frame.DispatchHelper")
oldSel = theDoc.CurrentSelection
dPS = pSourceSheet.DrawPage
For j = 0 To dPS.Count - 1
sh = dPS(j)
shPos = sh.Position
cCtrl.select(sh)
dispH.executeDispatch(theFr, ".uno:Copy", "", 0, Array())
cCtrl.setActiveSheet(pTargetSheet)
dispH.executeDispatch(theFr, ".uno:Paste", "", 0, Array())
newSh = theDoc.CurrentSelection(0)
newSh.Position = shPos
Next j
cCtrl.select(oldSel)
End SubThank you for macro. It is work correctly. Is it exist solution to replace one shape on another? Similar to pictures replacement by command Picture1.GraphicURL = Picture2.GraphicURL. My question is because I have to delete old shape and put them new one.