Macro para asignar imagen a una celda según su nombre

Con la siguiente macro pones las imágenes.

Sub insertarimagen()
'Por.DAM
On Error Resume Next
ruta = ActiveWorkbook.Path & "\"
For i = 1 To Range("A" & Rows.Count).End(xlUp).Row
 imagen = Cells(i, "A")
 Set img = ActiveSheet.Pictures.Insert(ruta & imagen)
 With Cells(i, 2)
 Arr = .Top
 Izq = .Left
 Anc = .Offset(0, 1).Left - .Left
 Alt = .Offset(1, 0).Top - .Top
 End With
 With img
 '.Name = numimg
 .ShapeRange.LockAspectRatio = msoFalse
 .Top = Arr
 .Left = Izq
 .Width = Anc
 .Height = Alt
 End With
 Set img = Nothing
Next
End Sub

Pon el archivo con esta macro en la misma carpeta en donde tienes las imágenes.

Las imágenes se van a poner dentro de la celda B1, B2, etc.

El alto y ancho de las celdas no se miden en centímetros, se mide en puntos o en pixeles.

Para el alto, 1 punto equivale a .035 cm, por lo que si quieres que de alto tenga 3.57cm, deberás poner tus filas a 102 puntos de alto.

Para el ancho, 1 punto equivale a .1918 cm, por lo que si quieres que de ancho tenga 1.91 cm, deberás poner la columna B en 9.9 puntos

Hola experto, comento lo sucedido, el archivo lo pase a la misma carpeta donde están las imágenes, cuando la ejecute no pasaba nada, probé cambiando, esta línea: cambiando A, por B

IMAGEN = Cells(i, "B")

Y me trajo un cuadro de imagen con error en cada celda, con el mensaje "No se puede mostrar la imagen vinculada, puede que se haya movido", cual cree que sea el problema?

Saludos Cordiales