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

https://plus.google.com/photos/107975053176222583503/album/6421556078796475233/6421556078890816898?authkey=CLnbvYT-mq7NwwE 

1 respuesta

Respuesta
1

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

https://plus.google.com/u/0/photos/photo/107975053176222583503/6421836652509715026?icm=false&authkey=CPDG7d_zjJGsbg 

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")

Añade tu respuesta

Haz clic para o

Más respuestas relacionadas