Select images and rename with cell value

Question

I have a range with images in cell "C". The value I want to rename the pictures is in cell "A". I have this code, and it works great, but I have to manually change every picture.

Is there a way to automate this?

I have 6000 pictures from products.

Sub RenameShape()
    Dim objName
    On Error GoTo CheckErrors
    If ActiveWindow.Selection.ShapeRange.count = 0 Then
        MsgBox "You need to select a shape first"
        Exit Sub
    End If
    objName = ActiveWindow.Selection.ShapeRange(1).Name
    objName = InputBox$("Assing a new name to this shape", "Rename Shape", objName)
    If objName <> "" Then
        ActiveWindow.Selection.ShapeRange(1).Name = objName
    End If

    Exit Sub

CheckErrors:
    MsgBox Err.Description

End Sub

Answer 1

This is an awesome piece of code. I found a solution for my needs.

Here is the solution:

GET pictures from a url and then rename the picture

Option Explicit

Private Declare PtrSafe Function URLDownloadToFile Lib "urlmon" _
Alias "URLDownloadToFileA" (ByVal pCaller As Long, _
ByVal szURL As String, ByVal szFileName As String, _
ByVal dwReserved As Long, ByVal lpfnCB As Long) As Long

Dim Ret As Long

'~~> This is where the images will be saved. Change as applicable
Const FolderName As String = "C:\Users\er\Documents\novotel\foodcost\Pictures\"

Sub DownloadImageLink()
    Dim ws As Worksheet
    Dim LastRow As Long, i As Long
    Dim strPath As String

    '~~> Name of the sheet which has the list
    Set ws = Sheets("Sheet1")

    LastRow = ws.Range("A" & Rows.count).End(xlUp).Row

    For i = 1 To LastRow '<~~ 2 because row 1 has headers
        strPath = FolderName & ws.Range("A" & i).value & ".png"

        Ret = URLDownloadToFile(0, ws.Range("B" & i).value, strPath, 0, 0)

        If Ret = 0 Then
            ws.Range("C" & i).value = "File successfully downloaded"
        Else
            ws.Range("C" & i).value = "Unable to download the file"
        End If
    Next i
End Sub