I put together a function that if you pass it a Cell object, will return TRUE if there is a shape containing a graphic anchored to it.
- Code: Select all Expand viewCollapse view
Function CellImageAnchor(oCell as Object) as Boolean
Dim oPageObj As Object
Dim oConv1 As Object
Dim oConv2 As Object
Dim sAA As String
Dim sCA As String
Dim shIdx As Integer
'If Not Globalscope.BasicLibraries.isLibraryLoaded("MRILib") Then
' Globalscope.BasicLibraries.LoadLibrary( "MRILib" )
'End If
'Dim oMRI as object
'oMRI = CreateUnoService( "mytools.Mri" )
shIdx = oCell.CellAddress.Sheet
CellImageAnchor = FALSE
oPageObj = ThisComponent.DrawPages.getByIndex(shIdx) ' index of sheet containing images.
REM see "Section 6.6. Human readable address of cell" in "Useful Macro Information For OpenOffice.org" by Andrew Pitonyak for details
oConv1 = ThisComponent.createInstance("com.sun.star.table.CellAddressConversion")
oConv2 = ThisComponent.createInstance("com.sun.star.table.CellAddressConversion")
oConv2.Address = oCell.CellAddress
sCA = oConv2.UserInterfaceRepresentation
for i = 0 to oPageObj.Count -1
oShape = oPageObj.getByIndex(i)
'oMRI.inspect oShape
if HasUnoInterfaces(oShape.Anchor,"com.sun.star.sheet.XCellAddressable") AND _
oShape.ShapeType = "com.sun.star.drawing.GraphicObjectShape" then
oConv1.Address = oPageObj.getByIndex(i).Anchor.CellAddress
sAA = oConv1.UserInterfaceRepresentation
If sCA = sAA then
CellImageAnchor = TRUE
Exit Function
endif
end if
next i
End Function
I tried to use the function
EqualUNOObjects(CellAddress1, CellAddress2) for the comparison but couldn't get it to work so I converted the
CellAddress objects to strings and compared those.
It seems work, at least with the limited testing I've done.
- Code: Select all Expand viewCollapse view
sub TestCellImageAnchor
Dim oCell as Object
Dim retval as Boolean
oCell = ThisComponent.Sheets.getByIndex(9).getCellByPosition(4,18)
retval = CellImageAnchor(oCell)
oCell = ThisComponent.Sheets.getByIndex(9).getCellByPosition(5,18)
retval = CellImageAnchor(oCell)
oCell = ThisComponent.Sheets.getByIndex(9).getCellByPosition(2,25)
retval = CellImageAnchor(oCell)
oCell = ThisComponent.Sheets.getByIndex(9).getCellByPosition(1,1)
retval = CellImageAnchor(oCell)
oCell = ThisComponent.Sheets.getByIndex(9).getCellByPosition(1,9)
retval = CellImageAnchor(oCell)
end sub
The test sheet (Sheet10) has graphic objects anchored to cells B10, C26 and E19. The sheet also has 2 control shapes anchored to cells and a graphic anchored to the page, which are all ignored by the function.
If your problem has been solved, please edit this topic's initial post and add "[Solved]" to the beginning of the subject line
Apache OpenOffice 4.1.7 & LibreOffice 6.1.5.2 - Windows 10 Professional