Forum Discussion
Jagodragon
May 24, 2022Iron Contributor
Find if range has pictures [Solved with ongoing improvements?]
I have to find if each cell in a range has a picture in it. I have the script below running in VB and need to figure out how to make it work for a range of cells. Function HASpic(Cell...
- May 27, 2022
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
May 24, 2022Iron Contributor
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.
- JagodragonMay 24, 2022Iron Contributor
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 Function
- mtarlerMay 24, 2022Silver Contributor
Jagodragon 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 Function
I'm guessing you don't need it but since I did it (more for my own satisfaction) i thought I would post it.
- JagodragonMay 26, 2022Iron ContributorI 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?