Extraer imágenes de una hoja excel
A ver si me podéis ayudar por favor.
Necesitaría saber si teniendo una hoja excel con imágenes, referencia etc... Podríamos extraer todas las imágenes de esta hoja a una carpeta identificando cada una con el nombre de la referencia que aparece en la siguiente columna. Es decir la columna A contiene las imágenes y la columna B la referencia. Pues poder extraer todas las imágenes (con el mismo tamaño que tienen en la celda), ¿nombrando cada imagen con su correspondiente referencia de la columna B. Es posible?
Te anexo la macro.
Cambia en la macro "lista" por el nombre de tu hoja.
Crea una nueva hoja y la llamas "temp"
Es preciso que la esquina superior izquierda de cada una de tus imágenes se encuentre dentro de la celda correspondiente a su fila, revisa la siguiente imagen:
También cambia en la macro "C:\trabajo\imagen\", por el nombre de la carpeta donde quieras extraer las imágenes. Cada imagen será guardada con extensión "jpeg"
Sub CopiarCeldasComoImagen()
'Por.Dante Amor
'
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Set h1 = Sheets("lista") 'hoja con las imágenes
Set h2 = Sheets("temp") 'hoja temporal
h2.Cells.Clear
ruta = "C:\trabajo\imagen\" 'ruta destino de los archivos
'
For i = 2 To h1.Range("B" & Rows.Count).End(xlUp).Row
h2.DrawingObjects.Delete
nom = h1.Cells(i, "B")
For Each img In h1.DrawingObjects
top_ini = h1.Cells(i, "B").Top
top_fin = h1.Cells(i + 1, "B").Top
top_img = img.Top
If top_img >= top_ini And top_img <= top_fin Then
h1.Select
img.Select
anc = img.Width
alt = img.Height
Selection.Copy
archivo = nom & ".jpeg"
'
h2.Shapes.AddChart
With h2.ChartObjects(1)
.Width = anc
.Height = alt
.Chart.Paste
.Chart.Export ruta & archivo
.Delete
End With
Exit For
End If
Next
Next
'
Application.DisplayAlerts = True
MsgBox "Imágenes exportadas "
End Sub
'S aludos. Dante Amor. Recuerda valorar la respuesta. G racias
