excelvbashapeswindows-11excel-365

Need an excel VBA code to determine whether or not a cell contains an embedded picture


Following are IsPictureInCell and CopyCellPictureToClipboard vba funtions. I'd appreciate your suggested modifications to these two functions so they will correctly work with pictures locked into cells.

' Checks if a picture exists in the specified cell
Function IsPictureInCell(Cell As Range) As Boolean
    Dim shp As Shape, shpRange As Range
    For Each shp In Cell.Parent.Shapes
        Set shpRange = Cell.Parent.Range(shp.TopLeftCell, shp.BottomRightCell)
        If Not Intersect(shpRange, Cell) Is Nothing Then
            IsPictureInCell = True
            Exit Function
        End If
    Next
End Function
' Copies pic to clipboard if the Cell contains a picture
Function CopyCellPictureToClipboard(Cell As Range) As Boolean
    On Error Resume Next
    Dim shp As Shape
    For Each shp In Cell.Parent.Shapes
        If Not Intersect(shp.TopLeftCell, Cell) Is Nothing Then
            shp.Copy
            CopyCellPictureToClipboard = True
            Exit Function
        End If
    Next
    CopyCellPictureToClipboard = False
End Function

Solution

  • As far as I know, there is no special property that determines whether a cell contains an image as content (in cell, not a shape object). You can only use the property Range.HasRichDataType, which in this case equals True. But this property was primarily intended to identify linked data types, so linked data should also be excluded. In total, we will get the function:
    Function HasImage(rng As Range) As Boolean
    HasImage = rng.HasRichDataType And rng.LinkedDataTypeState = 0
    End Function
    Meanwhile, it can be used until the creators of Excel come up with something new.
    When converting an image in a cell to an image over cells (an object), this function reacts immediately, while the IsPictureInCell function, which checks for the existence of an object in a cell, requires a sheet recalculation (Ctrl+Alt+F9).

    enter image description here![PictureInCell]

    Explanation to the image: PRAWDA = TRUE, FAŁSZ = FALSE