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
Option Explicit
Public Function IsOne(val As Variant) As Boolean
IsOne = False
If val = 1 Then
IsOne = True
End If
End Function
Public Function IsOneRange(rng As Range) As Variant
Dim output() As Boolean
Dim i As Integer
ReDim output(1 To rng.Rows.Count)
For i = 1 To rng.Rows.Count
output(i) = IsOne(rng.Cells(i, 1))
Next i
IsOneRange = Application.WorksheetFunction.Transpose(output)
End Function
To return an array, you must build it in the function. My example above uses a simple "IsOne" instead of "HasPic", but I think you will see the idea.
Let me know if it works.
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?
