How to get Values Based on the pictures drag into a cell

[Subvongola]

hi all,

I had created a drag and drop excel sheet whereby there are a total of 5 picture. The user is able to drag around the picture and put them into cell B1 to B3 respectively. After each picture had been drop into the cell, the name of the picture will be display at M5 to M7 respectively.

I had created the drag and drop part. May I know is there a way to retrieve value from each of the pictures drag and dropped into the cells?

if you need he excel sheet for easier reference, I will be greatly to send you.

Please help me. Thank you

 

[DanteAmor]

After putting your images, execute the following macro. It will search the image inside B1 to B3 and put its name in cells M5 to M7

Sub Name_Picture()
    Dim rng As Range
    Dim img As Object
    Dim cells1, cells2
    Dim i as long
    '
    cells1 = Array("B1", "B2", "B3")
    cells2 = Array("M5", "M6", "M7")
    For i = LBound(cells1) To UBound(cells1)
        Set rng = Range(cells1(i))
        For Each img In ActiveSheet.DrawingObjects
            If Not Intersect(img.TopLeftCell, rng) Is Nothing And _
               Not Intersect(img.BottomRightCell, rng) Is Nothing Then
                Range(cells2(i)).Value = img.Name
                Exit For
            End If
        Next
    Next
End Sub

Try and tell me

 

[Subvongola]

After putting your images, execute the following macro. It will search the image inside B1 to B3 and put its name in cells M5 to M7

Sub Name_Picture()
    Dim rng As Range
    Dim img As Object
    Dim cells1, cells2
    Dim i as long
    '
    cells1 = Array("B1", "B2", "B3")
    cells2 = Array("M5", "M6", "M7")
    For i = LBound(cells1) To UBound(cells1)
        Set rng = Range(cells1(i))
        For Each img In ActiveSheet.DrawingObjects
            If Not Intersect(img.TopLeftCell, rng) Is Nothing And _
               Not Intersect(img.BottomRightCell, rng) Is Nothing Then
                Range(cells2(i)).Value = img.Name
                Exit For
            End If
        Next
    Next
End Sub

Try and tell me

thank you Mr DanteAmor. I placed the code in a button. Tried it but nothing happened.

 

[DanteAmor]

The image must be completely inside cell B1

 

[Subvongola]

I see. thank you

 

[DanteAmor]

You're welcome