Impresión continua en Excel, macro.
Tengo una consulta a ver quien me colabora con sus conocimientos
Adjuntare imágenes de la plantilla para que puedan tener claridad
Tengo una hoja que constara de miles de números de muestras en la columna A
Tengo otra hoja donde hay una pequeña plantilla de como entregar los datos de la HOJA "muestras"
Con formulas ya esa plantilla se alimenta sola BUSCARV al poner un numero de muestras me trae los datos
He tratado de ajustar muchas macros y nada
Me gustaría me enseñen como hacer ***para que a la hora hacer un reporte pueda automatizar la impresión de la plantilla en cada muestra*** sin tener que escribir manualmente cada numero
la idea es tener una casilla de rangos de muestras (ejemplo muestra INICIO ____ muestra FIN _____)
Y recorra cada numero e imprima
Si puedo cuadrar varios cintillos en una sola hoja mejor
Pero eso lo puedo hacer manualmente desde FINEPRINT
Agradezco
Mucho el que te hayas tomado el tiempo de leer
1 Respuesta
Te anexo la macro.
Para ejecutar la macro necesitas 3 hojas. La hoja con las muestras, la hoja con la plantilla y una tercera hoja donde vas a poner el rango de números.
Cambia los nombres de las hojas en estas líneas de la macro:
Set h1 = Sheets("muestras")
Set h2 = Sheets("plantilla")
Set h3 = Sheets("rango")En la hoja rango, en la celda B3 pon el número inicial y en la celda B3 pon el número final. Si omites el número final, solamente se imprimirá el número inicial. El número final deberá ser mayor al número inicial.
Lo que hace la macro es poner el número en la celda C6 de la hoja "plantilla" e imprimir la hoja "plantilla", y repetir el ciclo.
Sub Llenar_Plantilla()
'Por.Dante Amor
Set h1 = Sheets("muestras")
Set h2 = Sheets("plantilla")
Set h3 = Sheets("rango")
'
ini = Val(h3.Range("B3").Value)
fin = Val(h3.Range("C3").Value)
If ini = "" Or ini = 0 Or Not IsNumeric(ini) Then
MsgBox "Pon el número inicial"
Exit Sub
End If
If fin = "" Then
fin = ini
Else
If Not IsNumeric(fin) Or fin < ini Then
MsgBox "Pon el número final correcto"
Exit Sub
End If
End If
'
For i = 3 To h1.Range("A" & Rows.Count).End(xlUp).Row
If Val(h1.Cells(i, "A").Value) > fin Then Exit For
If Val(h1.Cells(i, "A").Value) >= ini And Val(h1.Cells(i, "A").Value) <= fin Then
h2.Range("C6") = h1.Cells(i, "A")
h2.PrintOut
End If
Next
MsgBox "Impresiones termiandas"
End Sub.
'S aludos. Dante Amor. Recuerda valorar la respuesta. G racias
.
Avísame cualquier duda
.
Buenas Tardes
se ve muy interesante el Código
lo voy a montar y te confirmo
¡Gracias! por adelantado
Hola
Dante que tal
disculpa
no se si estoy haciendo algo mal
me corriges me manda este error
muchas gracias por tu tiempo
saludos
Los nombres de tus hojas deben coincidir con estos nombres:
Set h1 = Sheets("muestras")
Set h2 = Sheets("plantilla")
Set h3 = Sheets("rango")
