Insertar de manera automática una serie de imágenes en Excel con macros
Tengo gran cantidad de imágenes que insertar en un archivo de excel. Se que se pueden insertar desde el directorio con Workbook.Path sin estar definiendo una ruta especifica como C:\mis documentes\imagenes\etc
Este es el ejemplo, el numero de carpetas, de hojas y de archivos varían:
Mi problema es que son muchos archivos y aunque ya los tengo separados en diferentes carpetas quisiera que me ayudaran con un macro que las insertara y ubicara mis imágenes de forma automática con un botón :) sin tener que esta abriendo carpeta por carpeta
En la primera parte con se ve la imágenes las tengo que ordenar así, pero varían entre 2 y 6 imágenes y miden como 7cm
Y allí donde dice familia va una sola imagen como de 12cm de ancho
En la siguientes hojas se insertan varias imágenes que se van distribuyendo a lo largo de algunas hojas (las hojas son tamaño carta 11"x8.5") estas imágenes que caben dos o tres miden también 12cm de ancho
Pero también hay imágenes que ocupan casi toda la hoja aunque miden también 12cm de ancho
Son mucho archivos los que tengo que insertar de imágenes y me lleva mucho tiempo abrir las ventanas selecciona e insertar
Lo que quisiera es que con un clic en el botón, se insertaran y se acomodaran las imágenes automáticamente, de la forma en que vienen las imágenes, eso me ayudaría muchísimo, espero que alguien me pueda ayudar por favor, en intentado con códigos de internet pero no me funcionan. He entendido que se puede hacer con un array y un bucle y definiendo algunas celdas con el numero de celda o su nombre, pero aun no logro hacer que funcione, no se bien como hacerle aun soy muy nueva en las macros de Excel.
1 Respuesta
Una conversación de hace pocos días y que puede servir para que te guíes:
Comentas
Abraham Valencia
woow esta perfecto ya la probe :D gracias!!! solo que no se como cambiarle las medidas????? :( porque como que salen muy pequeñas las imagenes y tambi no se si se pueda automatizar porque veo que tengo que ir abriendo carpeta por carpeta y quisiera que con solo darle clic al boton se insertaran solas, sin abrir las carpetas, ojala pudieras ayudarme un poquito mas si? porfis?
Para no usar el método "Application.GetOpenFilename" y directamente usar/insertar los archivos de una carpeta, debe usar la función "Dir", aquí un ejemplo de su uso:
Como extraer un numero de teléfono de varios TXT y representarlos en una hoja de Excel
Si en realidad quieres ir más allá y no solo necesitas carpetas sino también subcarpetas lo conveniente es usar el objeto "FileSystemObject", del que hay mucha lectura en internet.
Para cambiar el tamaño de las imágenes, debes usar sus propiedades "Width" y "Height" pero previamente poner la propiedad "LockAspectRatio" en "False":
With Imagen .ShapeRange.LockAspectRatio = False .Top = Arriba .Left = Izquierda .Width = 300 .Height = 200 End With
Ve intentandolo y ya sobre tus avances te vamos ayudando.
Abraham Valencia
Perdon yo aqui milestando creo que no lo estoy entendiendo bien o no lo puedo aplicar de manera correcta
Sub InsertarVariasImagenes()
Dim Inicioarray As String, Finalarray As String
Dim Imagen As Object
Dim LoopArray As Long
Dim Arriba As Double, Izquierda As Double, Ancho As Double, Alto As Double
If Range("A1") = "" Then
Range("A1") = 1
End If
' cambie esta seccion pero ahora no me inserta nada
ListadeImagenes = Dir(ThisWorkbook.Path & "\*.jpg*")
If IsArray(ListadeImagenes) Then
Let Inicioarray = LBound(ListadeImagenes)
Let Finalarray = UBound(ListadeImagenes)
For LoopArray = Inicioarray To Finalarray
Set Imagen = Hoja1.Pictures.Insert(ListadeImagenes(LoopArray))
With Range("A" & Range("A1").Value & ":I" & (Range("A1").Value + 9))
Arriba = .Top
Izquierda = .Left
Ancho = .Offset(0, .Columns.Count).Left - .Left
Alto = .Offset(.Rows.Count, 0).Top - .Top
End With
With Imagen
.Top = Arriba
.Left = Izquierda
.Width = Ancho
.Height = Alto
End With
Range("A1").Value = Range("A1").Value + 10
Next LoopArray
End If
Set Imagen = Nothing
End Sub
Prueba así:
Sub InsertarVariasImagenes()
Dim Imagen As Object
Dim ListadeImagenes As String
Dim Arriba As Double, Izquierda As Double
If Range("A1") = "" Then
Range("A1") = 1
End If
ListadeImagenes = Dir(ThisWorkbook.Path & "\*.jpg*")
Do While Len(ListadeImagenes) > 0
Set Imagen = Hoja3.Pictures.Insert(ThisWorkbook.Path & "\" & ListadeImagenes)
With Range("A" & Range("A1").Value & ":A" & (Range("A1").Value + 9))
Arriba = .Top
Izquierda = .Left
End With
With Imagen
.ShapeRange.LockAspectRatio = False
.Top = Arriba
.Left = Izquierda
.Width = 200
.Height = 100
End With
Range("A1").Value = Range("A1").Value + 10
ListadeImagenes = Dir
Loop
Set Imagen = Nothing
End SubReemplaza es "hoja3" por la tuya.
Abraham Valencia
Funciona muy bien, solo una ultima consulta
entiendo que esta linea es la que ubica las imagenes
With Range("A" & Range("A1").Value & ":A" & (Range("A1").Value + 9))hay alguna manera en que en lugar de ponerlas hacia abajo las ponga una al lado de la otra? perdon por ser tan molesta, pero apenas voy aprendiendo a como manejar los macros de excel
Para que aparezcan en columnas las imágenes y no en filas es mejor usar "Cells" y no "Range" pues con ese último objeto será más complicado verificar las columnas. Intenta y comentas.
Abraham Valencia
