Rename pictures in a particular cell

[yinkajewole]

I have pictures on range F7 in all sheets. unfortunately the names of the picture varies in all the sheets. how do i give it a uniform name like "mypic"

 

[Jaafar Tribak]

Maybe something along these lines :

Function PicFromRange(ByVal R As Range) As Shape

    Dim shp As Shape
    
    For Each shp In R.Worksheet.Shapes
        If shp.TopLeftCell.Address = R.Address Then
            Set PicFromRange = shp: Exit Function
        End If
    Next shp

End Function


Sub Test()

    Dim ws As Worksheet, shp As Shape
    
    For Each ws In ThisWorkbook.Worksheets
        Set shp = PicFromRange(ws.Range("f7"))
        If Not shp Is Nothing Then
            shp.Name = "mypic"
        End If
    Next ws

End Sub

 

[eduzs]

I suppose even though you can set the same name for all pictures, you can not format them at once.
That said, the way to know if a shape is in a range is:

If Not Intersect(Range(activesheet.shapes(1).TopLeftCell.Address), activesheet.range("A1")) Is Nothing Then DoSomeThing

 

[yinkajewole]

Maybe something along these lines :

Function PicFromRange(ByVal R As Range) As Shape

    Dim shp As Shape
    
    For Each shp In R.Worksheet.Shapes
        If shp.TopLeftCell.Address = R.Address Then
            Set PicFromRange = shp: Exit Function
        End If
    Next shp

End Function


Sub Test()

    Dim ws As Worksheet, shp As Shape
    
    For Each ws In ThisWorkbook.Worksheets
        Set shp = PicFromRange(ws.Range("f7"))
        If Not shp Is Nothing Then
            shp.Name = "mypic"
        End If
    Next ws

End Sub

this did not rename the picture as expected

 

[yinkajewole]

I suppose even though you can set the same name for all pictures, you can not format them at once.
That said, the way to know if a shape is in a range is:

If Not Intersect(Range(activesheet.shapes(1).TopLeftCell.Address), activesheet.range("A1")) Is Nothing Then DoSomeThing

there are many pictures on the sheet

 

[Jaafar Tribak]

The pictures TopLeft corner must lie exactly within range F7 - Can you check that ?

 

[eduzs]

I see no use in renaming shapes to a unic name.
What do you want to do specifically (resize, delete, etc.)?
This example rename the shapes that are in "F7" cell range in all sheet of activeworkbook:

Dim oSheet As Worksheet, oShp As Shape

For Each oSheet In ActiveWorkbook.Sheets
  For Each oShp In oSheet.Shapes
     If Not Intersect(Range(oShp.TopLeftCell.Address), oSheet.Range("F7")) Is Nothing Then oShp.Name = "UnicName"
   Next oShp
Next oSheet

 

[yinkajewole]

The pictures TopLeft corner must lie exactly within range F7 - Can you check that ?

exactly, i checked it

 

[yinkajewole]

I see no use in renaming shapes to a unic name.
What do you want to do specifically (resize, delete, etc.)?
This example rename the shapes that are in "A1" cell range:

Dim oSheet as Worksheet, oShp as shape

For Each oSheet in Activeworkbook.Sheets
  For each oShp in oSheet.shapes 
     If Not Intersect(Range(oSheet.oShp.TopLeftCell.Address), oSheet.range("F7")) Is Nothing Then oSheet.oShp.name="UnicName"
   Next oShp
Next oSheet

I want to copy the pictures to another workbook, that's why I need the name

 

[Jaafar Tribak]

exactly, i checked it

Can you select one of pictures and run this in the immediate window:

?Selection.TopLeftCell.Address

Do you get F7 ?