VBA: El método Shapes.AddPicture para incorporar imágenes en Excel.

Con frecuencia se me ha planteado, al respecto de este post (ver), cuál era la forma de insertar imágenes en Excel de manera automática, desde una ruta concreta, pero rompiendo cualquier vínculo con el fichero origen de la imagen.

[...] Mi problema es el mismo que exponían mis compañeros en los comienzos de este foro (hace mil años): necesitaría que las imágenes estuvieran incrustadas y no vinculadas [...]

El objetivo es claro, insertar imágenes desde una ruta, pero perder cualquier vínculo existente para evitar que si el fichero de la imagen desaparece, nuestro Excel pierda la imagen:

Fijémonos en el mensaje del cuadro de imagen: No se puede mostrar la imagen vinculada. Puede que se haya movido, cambiado de nombre o eliminado el archivo. Compruebe que el vínculo señala al archivo y ubicación correcta.

Muy aclaratorio mensaje, y muy real, ya que es muy frecuente que ocurran estos casos al trabajar en Red y compartir ficheros...

La solución es emplear el método Shapes.AddPicture, a partir del cual crearemos una imagen a partir de un archivo existente, en una ruta concreta, obteniendo un objeto Shape que muestre la imagen...
La ventaja de este método es que podemos configurar si deseamos la imagen con o SIN vínculo!!

La sintaxis del método:
Shapes.AddPicture(Filename,LinkToFile, SaveWithDocument, Left, Top, Width, Height)
y los parámetros a definir podrían ser:
Filename
Requiere una cadena tipo String, con la ruta del fichero a importar, esto es, el fichero/imagen a partir de la cual se crearña el objeto Shape.

LinkToFile
Requiere una contante tipo 'MsoTriState'. Controla cómo será el vínculo, o si queremos exista éste.
Las constante puede ser:
1-msoFalse (hará independiente la imagen importada)
2-msoTrue (se creará un vínculo hacia la ruta o ubicación de la imagen indicada)

SaveWithDocument
Requiere una contante tipo 'MsoTriState', y controla la acción para conservar o guardar la imagen dentro del libro.

Left, Top, Width, Height
estas son propiedades de ubicación en la hoja de cálculo y dimensiones (Alto y Ancho), medidos en Points!!.

Para resolver nuestra cuestión en particular, insertamos el siguiente código dentro de un módulo estándar del explorador de proyectos del Editor de VB.:

Sub FicherosCarpeta()
'www.excelforo.com
'Añadir Imagenes a Excel

'Crea una Imagen desde un fichero y
'devuelve un objeto NO vinculado a el fichero origen

Dim Ruta As String
Dim Fotos As Object
Dim rng As Range, celda As Range

'Saltamos posibles errores
On Error Resume Next
Application.ScreenUpdating = False
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Dim img As Shape
'si existe alguna foto, la borro:
On Error Resume Next
For Each img In ActiveSheet.Shapes
If img.Type = 11 Then img.Delete
Next
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'Creamos el objeto FileSystemObject que
'proporciona acceso al sistema de archivos de un equipo
Set fso = CreateObject("Scripting.FileSystemObject")
'Indicamos la ruta de donde vamos a obtener
'los ficheros, en este caso E:\excelforo\Fotos\
Ruta = "E:\excelforo\Fotos\"
'definimos dos variables que necesitaremos,
'para recuperar el nombre de la carpeta, y los ficheros que haya dentro
Set Carpeta = fso.GetFolder(Ruta)
Set ficheros = Carpeta.Files
'damos un título en negrita para la celda A1
With Range("A1")
.Value = "Ficheros de la carpeta " & Ruta
.Font.Bold = True
End With
'escribimos los ficheros, a partir de A2
Range("A2").Select
For Each archivo In ficheros
'escribimos el nombre del fichero
ActiveCell = archivo.Name
'bajamos una fila
ActiveCell.Offset(1, 0).Select
Next archivo
ActiveCell.EntireColumn.AutoFit
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Set rng = Worksheets("Hoja2").Range("A2:A15")
For Each celda In rng
If Len(Trim(celda)) > 0 Then
'defino la celda equivalente de la columna A y la selecciono
Set r1 = Cells(celda.Row, "B")
r1.Select
'se inserta la imagen de la ruta definida
'Set Fotos = ActiveSheet.Pictures.Insert(Ruta & celda.Value)
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'VARIANTE PARA AÑADIR IMAGEN NO VINCULADA AL FICHERO Y RUTA!!
Set Fotos = ActiveSheet.Shapes.AddPicture(Filename:=Ruta & celda.Value, _
linktofile:=msoFalse, savewithdocument:=msoCTrue, _
Left:=0, Top:=0, Width:=-1, Height:=-1)
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'con la posición definida respecto a la celda de la columna B seleccionada
With Fotos
.Top = r1.Top
.Width = .Width / 1.5
.Height = .Height / 1.5
.Left = r1.Left + (r1.Width - Fotos.Width) / 2
.ShapeRange.LockAspectRatio = msoFalse
r1.EntireRow.RowHeight = .Height
.Placement = xlMoveAndSize
End With
r1.Select
End If
Next celda
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'Limpiamos los objetos y variables definidas
Set fso = Nothing
Set Carpeta = Nothing
Set ficheros = Nothing
Set rng = Nothing
Set r1 = Nothing
Set Fotos = Nothing

Application.ScreenUpdating = True
End Sub

La parte diferente del código responde por tanto a la línea:

Set Fotos = ActiveSheet.Shapes.AddPicture(Filename:=Ruta & celda.Value, _
            linktofile:=msoFalse, savewithdocument:=msoCTrue, _
            Left:=0, Top:=0, Width:=-1, Height:=-1)
       
 

donde vemos configurados los tres parámetros importantes:
Filename:=Ruta & celda.Value: donde indicamos la ubicación de la imagen a importar.
linktofile:=msoFalse: donde decimos que NO deseamos exista un vínculo con la ubicación del fichero
y
savewithdocument:=msoCTrue: donde controlamos y exigimos la imagen quede guardad con el Libro de trabajo.

En definitiva conseguimos la acción buscada, hemos importado la imagen sin vínculo!!; y por tanto no se perderá aunque la ubicación, ruta o fichero desaparezca o cambie...