Impresión de listados en etiquetas individuales
Buenas noches,
A ver si alguien me puede ayudar, tengo una macro que coge un dato de un listado y lo copia a una segunda hoja donde tengo configurado el formato de una etiqueta, esta se imprime con ese dato y después vuelve a buscar el segundo dato del listado y repite la operación hasta el rango que he especificado, donde se detiene. Adjunto el código
Sub TestImprimirFichas()
Application.ScreenUpdating = False
ActiveSheet.PageSetup.PrintArea = "$A$1:$G$4"
Dim celda As Range
For Each celda In _
Worksheets("LISTADO PREPARACION").Range("A2:A10")
Worksheets("ETIQUETAS").[A1] = celda
Worksheets("ETIQUETAS").PrintPreview 'Out COPIES:=Range("J1")
Next
Application.ScreenUpdating = True
End Sub
Ahora quiero imprimir las etiquetas de dos en dos y que coja el primer dato lo ponga en [A1] y además que coja el segundo dato y lo ponga en [E2], así hasta que se acabe el rango especificado. La verdad es que lo máximo que he conseguido ha sido repetir el mismo dato en [A1] y [E1] poniendo Worksheets("ETIQUETAS").[E1] = celda.
Agradecido de antemano por vuestra ayuda.
Saludos
1 respuesta
Juan Pedro!
Hay varias formas de hacerlo pero la haré de una forma no muy distinta de como lo has hecho. Usaremos un avarizble booleana llamada izquierda para que alternativamente mande los datos a un lado y otro
Sub TestImprimirFichas()
Application.ScreenUpdating = False
ActiveSheet.PageSetup.PrintArea = "$A$1:$G$4"
Dim celda As Range
Dim Izquierda As Boolean
Izquierda = True
For Each celda In _
Worksheets("LISTADO PREPARACION").Range("A2:A10")
If Izquierda Then
Worksheets("ETIQUETAS").[A1] = celda
Else
Worksheets("ETIQUETAS").[E1] = celda
End If
Izquierda = not Izquierda
Worksheets("ETIQUETAS").PrintPreview 'Out COPIES:=Range("J1")
Next
Application.ScreenUpdating = True
End Sub
-------------------
No he podido probarlo porque lo mejor hubiera sido que me mandarás el libro para hacer pruebas, pero pienso que puede servirte. Si no es así ya me lo diras, y si ya está bien, no olvides puntuar.
Hola Valero, ante todo muchas gracias por tu ayuda, he probado y si que da los datos en ambas celdas, solo existe un problema, al inicio solo sale el primer dato en A1 dejando vacio E1, y luego siempre repite dos veces el dato de E1.
He subido a MEGA el fichero para que lo puedas ver.
Gracias
https://mega.co.nz/#!UNgCiJ4D!ZOQ30r-TUmIf1rySeDQXkCllctK_d51focEYE51W9B0
Vale, es que no entendía lo que querías hacer, ahora con el programa si. Simplemente es que ahora la orden PrintPreview no debe ejecutarse todas las veces sino la mitad de ellas. Justo después de procesar una etiqueta de la parte derecha. Y adicionalmente, una vez más al final si el número de artículos era impar. En este caso además haremos que el área de impresión quede reducida para no mostrar la etiqueta de la derecha
Eso será así.
Sub TestImprimirFichas()
Application.ScreenUpdating = False
ActiveSheet.PageSetup.PrintArea = "$A$1:$G$4"
Dim celda As Range
Dim Izquierda As Boolean
Izquierda = True
For Each celda In _
Worksheets("LISTADO PREPARACION").Range("A2:A10")
If Izquierda Then
Worksheets("ETIQUETAS").[A1] = celda
Else
Worksheets("ETIQUETAS").[E1] = celda
Worksheets("ETIQUETAS").PrintPreview 'Out COPIES:=Range("J1")
End If
Izquierda = Not Izquierda
Next
If Not Izquierda Then
ActiveSheet.PageSetup.PrintArea = "$A$1:$D$4"
Worksheets("ETIQUETAS").PrintPreview 'Out COPIES:=Range("J1")
End If
Application.ScreenUpdating = True
Range("a1") = ""
Range("e1") = ""
End Sub
------------
