jueves, 12 de mayo de 2016

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:

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



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...

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

8 comentarios:

  1. Hola Ismael, excelente artículo y muy útil para quienes no desean vincular la imagen. El problema que estoy teniendo es que la imagen se termina quedando en la celda A1. A continuación te paso el código que estoy desarrollando para ver si me puedes orientar dónde está el error. Desde ya muchas gracias.

    Norberto

    Sub Insertar1()

    Dim FileNames As Variant
    Dim Foto As Object

    FileNames = Application.GetOpenFilename(, , , , True)

    Counter = 1

    Range("B2").Select

    While Counter <= UBound(FileNames)
    Set Foto = ActiveSheet.Shapes.AddPicture(FileNames Counter), False, True, 0, 0, -1, -1)
    With Foto
    .Name = "foto_" & Counter
    .Top = ActiveCell.Top
    .Height = 50
    ActiveCell.EntireRow.RowHeight = .Height + 2

    If ActiveCell.ColumnWidth < .Width * 0.1891891891892 Then
    ActiveCell.ColumnWidth = .Width * 0.1891891891892
    End If

    End With
    ActiveCell.Offset(0, 1).Select
    Counter = Counter + 1
    Wend

    End Sub

    ResponderEliminar
  2. Perdón donde dice FileNames Counter) debe decir FileNames(Counter)

    ResponderEliminar
    Respuestas
    1. Hola Norberto,
      lo primero es que tienes un bucle While...Wend que parece nunca podrá aplicar, ya que con el método GetOpenFilename seleccionarás solo un fichero (así el contador counter no subirá nunca).
      Por tanto siempre trabajarás sobre la celda B2 seleccionada, insertando la imagen en esa celda, y en apariencia, al no tener asignada la propiedad .Left de la imagen, sobre la columna A.

      No sé exactamente qué necesitas hacer, pero con ese código sólo insertas una imagen en la celda B2...

      Saludos

      Eliminar
    2. Hola Ismael,
      Gracias por tu pronta respuesta. La idea es seleccionar una cantidad determinada de imágenes (es lo que hago con el método GetOpenFilname, en Counter voy contando las imagenes que selecciono) y luego colocar las mismas primero en la celda B2, y las consecutivas en las celdas contiguas a la derecha.
      El bucle lo utilizo para realizar la misma acción (o sea colocar la imagen) para cada imagen seleccionada.
      Slds

      Eliminar
    3. Hola Ismael,
      Tenías razón faltaba asignar la propiedad .Left
      Acabo de probar asignando .Left = ActiveCell.Left y ahora funciona a la perfección. El problema surge cuando uno se "enfrasca" desde un punto de vista y pierde el contexto.
      Nuevamente muchísimas gracias por tu ayuda.
      Slds

      Eliminar
    4. ;-)
      nos pasa a todos... son muchos detalles a tener en cuenta.
      Un saludo

      Eliminar