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?
1 Respuesta
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
