Get Name Box value of shape in current region

[PressEscape]

I wish to get the the name box value of the picture within a selected region with VBA

I can navigate and select the region. What's the trick to get the name box value (picture 27) and assign it to a variable?

 

[Jaafar Tribak]

Ok.

From the last image preview you posted, I can see a pattern. The Part number value of each shape is stored in the Offset (1,-1) from the shapes's topleft cell.

We can take advantage of this pattern to quickly rename all of the shapes with the part number value stored in the offset cell. For this, we will be using the following macro.

IMPORTANT: Try this on a mock copy of your worksheet, in case something goes wrong.

Sub Rename_Shapes()
    Dim oShp As Shape, vValue As Variant
    For Each oShp In ActiveSheet.Shapes
        vValue = oShp.TopLeftCell.Offset(1, -1).Value2
        If VarType(vValue) = vbDouble Then
            oShp.Name = "Part_" & vValue
        End If
    Next oShp
End Sub

After the macro above is finished running, verify that the shapes are correctly renamed based on the corresponding part number value that has been taken from the nearby offset cell. If all is fine, save the workbook.

The above macro, although it loops through all the shapes in the worksheet, it does so only once. No further looping will be subsequently needed when trying to retrieve the shapes(s) name.

Now, in oder to get the actual shape name, first select the nearby cell that contains the part number value and run the following demo code.

Sub Test()
    Dim sShapeName As String
    sShapeName = ActiveSheet.Shapes("Part_" & ActiveWindow.RangeSelection.Cells(1).Value2).Name
    MsgBox sShapeName
End Sub

 

[PressEscape]

Thanks Jaafar, Ill give it a try. I'm a bit busy today so please wait for an outcome tomorrow

 

[PressEscape]

I found some time to work on this.
I have this code that selects every Shape in the turn it was pasted into the worksheet
I think I can work with this and rename every shape with a part no. that is in an adjacent cell

I'm thinking of opening up a new post to work this through

Your thoughts please

Sub SelPic()

 'Workbooks("China Ordering - 2024 Edit.xls").Activate

    Dim pic As Shape
    
    For Each pic In ActiveSheet.Shapes
        If pic.Type = msoPicture Then
            pic.Select
        End If
        
        Debug.Print pic.Name
        pic.Copy
    
    Next pic

End Sub

 

[PressEscape]

I've got this code selecting each shape that I think I can work with.
What's the code to rename the picture to the part no. in the cell offset (-1,-1)

Note: as this code runs it selects the picture that is over a cell range

Sub SelPic()

    Dim pic As Shape
    
    For Each pic In ActiveSheet.Shapes
        If pic.Type = msoPicture Then
            pic.Select
        End If
        
        Debug.Print pic.Name
          
    Next pic

End Sub

 

[jolivanes]

From Post #9: "I don't want to loop through all shapes in the worksheet"
Without looping I would say that it will be difficult.

If you changed your mind, this would do it

Sub With_Looping()
Dim shp As Shape
    For Each shp In ActiveSheet.Shapes
        shp.Name = shp.TopLeftCell.Offset(1, -1).Value
    Next shp
End Sub

You could, or maybe should, include "If shp.Type = msoPicture Then" as you have in your Post #24

 

[PressEscape]

Thanks Jolivanes,
Nearly there
the picture sits over the 3rd row and the code interprets this as top left cell.
throughout the sheets to convert, the pictures could be over any of the rows
I'm thinking now we have the top left cell, can we use "select current region" and then set the active cell to the top left of the region. that would be "component" cell
then we can use offset (1,1).value
any ideas?

 

[Jaafar Tribak]

Maybe:

Sub With_Looping()
    Dim shp As Shape
    For Each shp In ActiveSheet.Shapes
        shp.Name = shp.TopLeftCell.CurrentRegion.Cells(2, 2).Value2
    Next shp
End Sub

 

[jolivanes]

Thinking outside the box Jafaar. Beautiful solved.

 

[PressEscape]

Thanks guy's
This has got the answer I was after. I guess I took the long way round but got there in the end

Cheers
PressEscape

 

[PressEscape]

Screen shot of my test run