Hola a todos!

Qué tal estás?, espero que muy bien : )

El viernes recibí una consulta de un lector que tenía el siguiente problema: de un conjunto de archivos Excel necesitaba extraer todas las imágenes que se habían incluido en varias hojas y pasarlas a una única hoja (todas juntas).

Bien, para poder realizar esta tarea con VBA tendremos que crear un código que sea capaz de seleccionar una carpeta específica (donde están los archivos), que solo reconozca los archivos Excel y pueda que recorra todos los libros y hojas para seleccionar solo un tipo de forma (picture).

Un trabajo interesante y del que ya existen en esta web varias macros con contenidos parciales pero que se pueden utilizar y modificar para obtener lo que necesitamos.

Imaginad que tenemos las siguiente imágenes en esta hoja:

Este tipo de shapes se corresponden con el tipo “Picture” y en código, el 13. Aquí os dejo una tabla con un resumen de tipos de shapes y códigos:

Y ahora tenemos que utilizar una macro que nos permita capturar esta información, la macro será la siguiente, está compuesta por una macro y por una función, cuando activamos la macro la función se ejecutará:

Sub EXTRAER_IMAGENES()
'Declaramos variables
Dim sFSO As Object, Directorio As String
Dim dir_Archivo As Variant
'Abrimos ventana de diálogo para seleccionar carpeta
Set dir_Archivo = Application.FileDialog(msoFileDialogFolderPicker)
dir_Archivo.Show
'Si no seleccionamos nada salimos del proceso
If dir_Archivo.SelectedItems.Count = 0 Then
Exit Sub
End If
'Capturamos el directorio del archivo seleccionado
Directorio = dir_Archivo.SelectedItems(1)
'Creamos objeto y ejecutamos función Carpeta
Set sFSO = CreateObject("Scripting.FileSystemObject")
CARPETA sFSO.GetFolder(Directorio)
End Sub

Una vez que ejecutamos la macro, se ejecutará la función CARPETA que va recorrer los archivos detectando los que sean Excel (cualquier versión) y extrayendo todas las imágenes.

Function CARPETA(ByVal nCarpeta)
'Declaramos variables
Dim j As Long, Subcarpeta As Object
Dim MiExt As String, iLibro As Object
Dim nHoja As Long, shapes As Object
Dim i As Long, file As Object
Application.ScreenUpdating = False
'Con la hoja activa
With ActiveSheet
'Iniciamos dos loop, uno que recorre las carpetas
For Each Subcarpeta In nCarpeta.SubFolders
CARPETA Subcarpeta
Next
'y otro que recorre los archivos y los indexa solo .xls
For Each file In nCarpeta.Files
MiExt = Right(file.Path, Len(file.Path) - InStrRev(file.Path, "."))
If MiExt Like "*xls*" Then
'Abrimos cada libro que se encuentra en la carpeta seleccionada
Set iLibro = Workbooks.Open(Filename:=file.Path)
'contamos las hojas de cada libro
nHoja = ActiveWorkbook.Worksheets.Count
'Iniciamos bucle.
For i = 1 To nHoja
'En cada hoja vamos seleccionando cada shape
'las copiamos y las pegamos en nuestro archivo
For Each shapes In Sheets(i).shapes
With shapes
If .Type = 13 Then
.Select
.Copy
ThisWorkbook.ActiveSheet.Paste Destination:=ThisWorkbook.ActiveSheet.Cells(j + 1, 1)
j = j + 10
End If
End With
Next shapes
Next i
'cerramos cada libro que hemos abierto
iLibro.Close
End If
Next
End With
End Function

El resultado es que en nuestro archivo recuperamos las imágenes contenidas en el archivo anterior.

Es importante que en la carpeta que contiene los archivos con las imágenes no incluyáis el archivo de la macro con el que vamos a extraer la información, la razón es que se generará un error dado que el archivo ya lo tenemos abierto.

El seleccionador de la macro selecciona carpetas (no archivos), por ello debéis seleccionar la carpeta o directorio con los archivos a tratar.

Descarga el archivo de ejemplo pulsando en: EXTRAER TODAS LAS FORMAS O SHAPES INCLUIDAS EN VARIOS ARCHIVOS EXCEL

¿Te ha resultado de interés?, puedes apoyar a Excel Signum con una pequeña donación.



¡¡Muchas gracias!!

Mediante la suscripción al blog, la realización comentarios o el uso del formulario de contacto estás dando tu consentimiento expreso al tratamiento de los datos personales proporcionados según lo dispuesto en la ley vigente (LOPD). Tienes más información al respecto en esta página del blog: Política de Privacidad y Cookies