Count of image/ Object in selected range

[Negi1984]

Hi All,

I have a problem statement where I need to count the no. of object/image in specific range/cell/merged cells.
For example
I have merged cell B19(covering B19 to E25). and these cells contains 2 objects(pdf/excel inserted as object).
Now I want to count the no. of objects , which are exist in this specific range.

I already have a code which I am using , but its checking only 1 object and I need to modify it to show output as count of object.

Looking forward for the valuable support.

Dim Pict As Object
   
   Application.Volatile
   Caddress = Cell.Address
   
   
   For Each Pict In Application.Caller.Parent.Pictures
      If Pict.TopLeftCell.Address = Caddress Or Pict.BottomRightCell.Address = Caddress Then
         HASpic = True
         Exit Function
      
      End If
   Next Pict
   HASpic = False
   
   
End Function

Regards,
Rajender

 

[Yongle]

Try this:

Function Pics(rng As Range)
    Dim Pict As Object, pRng As Range, mRng As Range, c As Long, p As Long
    On Error Resume Next
    Application.Volatile
    Set mRng = rng.MergeArea
    With rng.Parent
        For p = 1 To .Pictures.Count
            Set Pict = .Pictures(p)
            Set pRng = .Range(Pict.TopLeftCell, Pict.BottomRightCell)
            If Not Intersect(pRng, mRng) Is Nothing Then c = c + 1
        Next p
    End With
    Pics = c
End Function

with formula
=pics(B19)

 

[Negi1984]

Hi Yongle,

Thanks a lot for your prompt support. Code is working fine.

Regards,
Rajender

 

[Negi1984]

Hi Yongle,

One more thing I want to ask, I saved this code in Personal macro list. but when I am trying to use Pic function in other workbooks ,this function is not visible.
Could you please suggest what I am missing here.

Regards,
Rajender

 

[Yongle]

https://answers.microsoft.com/en-us/msoffice/forum/msoffice_excel-msoffice_custom-mso_2010/custom-functions-in-personal-macro-and-not-showing/5b8a0d76-956b-4cca-b4a1-d9b402228e54

This is the way the Personal macro workbook (PMW) operates. The macros are available in the macros dialog box, regardless of the active workbook, but the functions are not. Try one of the following:
1. Qualify the reference in your worksheet formulas, e.g.,
=Personal.xlsb!pics(B19)

2. Create a reference to your personal macro workbook in the workbook you're using (you will have to save your workbook as xlsm type instead of xlsx). Open the visual basic editor (VBE). Create a module in your workbook, and put something in it, even if it's only a comment. On the VBE menu, select Tools/References. Check the appropriate box in the dialog that appears.

3. Save your PMW as an add-in, activate it in Excel using File/Options/Add-ins/Manage add-ins.

 

[Domenic]

It looks like the function provided by Yongle can return incorrect results under certain circumstances. For example, when the range contains a mix of both merged and unmerged cells. Or, when a multi-cell range contains no merged cells. Here's my attempt...

Function getNumPics(rTarget As Range) As Long    
    Dim Pic As Object
    Dim numPics As Long
       
    Application.Volatile
    
    If rTarget.MergeCells Then
        Set rTarget = rTarget.MergeArea
    End If
    
    numPics = 0
    For Each Pic In rTarget.Parent.Pictures
       If Not Application.Intersect(Range(Pic.TopLeftCell, Pic.BottomRightCell), rTarget) Is Nothing Then
          numPics = numPics + 1
       End If
    Next Pic
    
    getNumPics = numPics
   
End Function

Hope this helps!

 

[Negi1984]

Hi Yongle,

Thanks a lot once again for your valuable support.
its working fine now.

Regards,
Rajender

 

[Negi1984]

Hi Domenic,

Thanks a lot for your valuable support as well. This is working perfectly.
Have a nice day to you.

Regards,
Rajender