Macro Para Catalogo de Productos
Para Dante Amor:
Hola! Necesito hacer un catálogo de productos a partir de una base de datos que se ira
completando con sus respectivos datos los cuales pueden ser N filas, pero siempre serán
las siguientes columnas:
Código Descripción Barras Precio
En la columna "barras" irán códigos asignados que nunca se repetirán, estos mismos
son asignados como nombres a imágenes que igualmente no se repiten en una carpeta las cuales se irán llamando en la
hoja 2 del documento.
Dejo una imagen para explicar mejor:
En la Hoja 1 de la imagen se ven 17 filas encerradas en colores (Pueden ser N filas),
estas mismas se copiaran a la hoja 2 acomodando los datos como se puede ver en la imagen.
En la imagen se ven las lineas verdes de color claro, hacen lo siguiente:
En la columna y fila A2 de la hoja 1 se copia a la A8 de la hoja 2
En la columna y fila B2 de la hoja 1 se copia a la A9 de la hoja 2
En la columna y fila C2 de la hoja 1 se copia a la A1 de la hoja 2
En la columna y fila D2 de la hoja 1 se copia a la A10 de la hoja 2
Y por ultimo se llama a la imagen del catalogo con el dato de la casilla "barras" +jpg
Luego de cada 4 productos acomodados desde la columna a la d se procederá a hacer lo mismo con los siguientes 4
como se puede ver con el cuadro rojo y los siguientes cuadros en la imagen, seguirá así hasta completar las N filas que contenga la hoja 1.
1 Respuesta
H o l a:
Te anexo la macro actualizada
Sub InsertarImagenes()
'Por.Dante Amor
Set h1 = Sheets("Hoja1")
Set h2 = Sheets("Hoja2")
'
h2.Cells.Clear
h2.DrawingObjects.Delete
h2.Columns("A:Z").ColumnWidth = 21.43
h2.Columns("A:Z").HorizontalAlignment = xlCenter
'
ruta = ThisWorkbook.Path & "\"
j = 1: k = 1: n = 1
For i = 2 To h1.Range("A" & Rows.Count).End(xlUp).Row
h2.Cells(j, k) = h1.Cells(i, "C")
h2.Cells(j + 7, k) = h1.Cells(i, "A")
h2.Cells(j + 8, k) = h1.Cells(i, "B")
h2.Cells(j + 9, k) = h1.Cells(i, "D")
arch = h1.Cells(i, "C") & ".jpg"
If Dir(ruta & arch) <> "" Then
With h2.Pictures.Insert(ruta & arch)
.ShapeRange.LockAspectRatio = msoFalse
.ShapeRange.Height = 85
.ShapeRange.Width = 115
.Left = h2.Cells(j + 1, k).Left
.Top = h2.Cells(j + 1, k).Top
End With
End If
k = k + 1: n = n + 1
If n = 5 Then j = j + 15: k = 1: n = 1
Next
h2.Select
MsgBox "Fin"
End SubEn la hoja1, tienes que poner tu lista de códigos, ya no es necesario que pongas un valor en la celda G1. En la hoja2 tendrás tus resultados.
