Forum Discussion
Find if range has pictures [Solved with ongoing improvements?]
Jagodragon good point. this should address that issue (i.e. search for pictures on the same sheet as the range your select)
Function HASpicR(x As Range) As Variant ' Yields TRUE if the cell identified by row and col contains a picture, ' otherwise FALSE Application.Volatile Dim p As Range Dim r, c As Long Dim s() As Variant r = x.Rows.Count c = x.Columns.Count ReDim s(1 To r, 1 To c) For Each Pict In x.Parent.Pictures Set p = Pict.TopLeftCell If Not Intersect(p, x) Is Nothing Then s(p.Row - x.Row + 1, p.Column - x.Column + 1) = True End If Next Pict HASpicR = s End Function
flexyourdata This worked great when combined with the change to make HASpic accept the an address(see edit in main post)! THANK YOU!
Function HASpicR(x As Range) As Variant
Dim output()
Dim i As Integer
ReDim output(1 To x.Rows.Count)
For i = 1 To x.Rows.Count
output(i) = HASpic(x.Cells(i, 1).Address)
Next i
HASpicR = Application.WorksheetFunction.Transpose(output)
End FunctionJagodragon I see you already have your solution but I will submit this because your solution has a few drawbacks. a) it is only for a single column b) it is looping through every picture for every cell in the range you are interested in. so if you have 100 pictures over 300 lines that means 30,000 checks. I reworked the original function to assign a TRUE value if it is in the range. I didn't initialize the whole array to FALSE so the output is 0 or True instead of T/F. But it only loops the pictures 1x and can handle multiple columns.
Function HASpicR(x As Range) As Variant
' Yields TRUE if the cell identified by row and col contains a picture,
' otherwise FALSE
Application.Volatile
Dim sourceCell, spillRange, p As Range
Dim r, c As Long
Dim s() As Variant
r = x.Rows.Count
c = x.Columns.Count
ReDim s(1 To r, 1 To c)
For Each Pict In Application.Caller.Parent.Pictures
Set p = Pict.TopLeftCell
If Intersect(p, x).Count Then
s(p.Row - x.Row + 1, p.Column - x.Column + 1) = True
End If
Next Pict
HASpicR = s
End FunctionI'm guessing you don't need it but since I did it (more for my own satisfaction) i thought I would post it.
- I get a #value error when I use this code. it has no range output. Am I missing something?
What are the sourceCell, spillRange and p variables used for?Jagodragon See attached. This is what it should look like:
sourceCell and spillRange are left over from something else I was trying and never deleted.
p temporarily holds the top left cell of the picture object as it loops through them.
I didn't do extensive testing so try the attached sheet first and then we can see what is different in your sheet.
mtarler Sir I need help, I have the same issue, but instead of pictures, I need the code for embedded objects (Excel spread sheets, PowerPoint, word documents) is that possible. instead of the Picture funcition, I used Shapes. unfortunately, it did not work.
Function HASpicR(x As Range) As Variant
' Yields TRUE if the cell identified by row and col contains a picture,
' otherwise FALSE
Application.Volatile
Dim sourceCell, spillRange, p As Range
Dim r, c As Long
Dim s() As Variant
r = x.Rows.Count
c = x.Columns.Count
ReDim s(1 To r, 1 To c)
For Each Pict In ActiveSheet.Shapes
Set p = Pict.TopLeftCell
If Intersect(p, x).Count Then
s(p.Row - x.Row + 1, p.Column - x.Column + 1) = True
End If
Next Pict
HASpicR = s
End Function
- This looks awesome! I will see if I can implement it. I actually had to rework the solution already to allow it to work on a different tab from the source array. So I have to do the same thing here. I'll let you know what I find.
