Exportar a un sólo PDF que depende de una ficha de empleado

Tengo un Excel donde hay una pestaña en la que según despliegas a una persona, se rellena su ficha con horarios, días libres,...

Tengo una macro hecha en la que automáticamente va cambiando el nombre del empleado e imprimiendo uno a uno. Ahora, lo que necesitaría es que, en vez de imprimir, exportara cada ficha de empleado a un archivo PDF, teniendo en cuenta que cada persona debería ir en una hoja, la orientación debería ser horizontal, también debe ser que copie el formato, los valores (ya que son fórmulas) y además hay celdas combinadas. En definitiva, lo que busco es que la ficha que se imprime aparezca igual en un PDF, con una hoja para cada ficha de las personas. Estoy buscando donde poder depositar el fichero, pero no lo encuentro.

1 respuesta

Respuesta
1

Envíame el archivo a mi correo

Mi correo [email protected]

En el asunto del correo escribe tu nombre de usuario “Daniel Roz” y el título de esta pregunta.

Hola, buenos días. Ya te he enviado el correo. Un saludo, gracias.

Te anexo la macro actualizada

Sub imprime()
'Por.Dante Amor
    Pregunta = MsgBox("Se van a imprimir TODOS los empleados. ¿ESTÁS SEGURO?", _
        vbQuestion + vbYesNo, "¡¡ OJO !!. Importante")
    If Pregunta = 7 Then End
    '
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    Set h1 = Sheets("Planificación anual")
    Set h2 = Sheets("Calendario")
    '
    Set h3 = Sheets.Add
    '
    With h3.PageSetup
        .LeftHeader = ""
        .CenterHeader = ""
        .RightHeader = ""
        .LeftFooter = ""
        .CenterFooter = ""
        .RightFooter = ""
        .LeftMargin = Application.InchesToPoints(0.669291338582677)
        .RightMargin = Application.InchesToPoints(0.47244094488189)
        .TopMargin = Application.InchesToPoints(0.275590551181102)
        .BottomMargin = Application.InchesToPoints(0.354330708661417)
        .HeaderMargin = Application.InchesToPoints(0.15748031496063)
        .FooterMargin = Application.InchesToPoints(0.15748031496063)
        .PrintHeadings = False
        .PrintGridlines = False
        .PrintComments = xlPrintNoComments
        .PrintQuality = 600
        .CenterHorizontally = False
        .CenterVertically = False
        .Orientation = xlLandscape
        .Draft = False
        .PaperSize = xlPaperA4
        .FirstPageNumber = xlAutomatic
        .Order = xlDownThenOver
        .BlackAndWhite = False
        .Zoom = 100
        .PrintErrors = xlPrintErrorsDisplayed
        .OddAndEvenPagesHeaderFooter = False
        .DifferentFirstPageHeaderFooter = False
        .ScaleWithDocHeaderFooter = True
        .AlignMarginsHeaderFooter = True
        .EvenPage.LeftHeader.Text = ""
        .EvenPage.CenterHeader.Text = ""
        .EvenPage.RightHeader.Text = ""
        .EvenPage.LeftFooter.Text = ""
        .EvenPage.CenterFooter.Text = ""
        .EvenPage.RightFooter.Text = ""
        .FirstPage.LeftHeader.Text = ""
        .FirstPage.CenterHeader.Text = ""
        .FirstPage.RightHeader.Text = ""
        .FirstPage.LeftFooter.Text = ""
        .FirstPage.CenterFooter.Text = ""
        .FirstPage.RightFooter.Text = ""
    End With
    '
    For n = 7 To h2.Range("BG3")
        h2.Range("E6") = h1.Range("F" & n)
        h2.PrintOut Copies:=1, Collate:=True
        u = h3.UsedRange.Rows(h3.UsedRange.Rows.Count).Row + 1
        If u = 2 Then u = 1
        Set rango = Range("A1:AD40")
        h2.Range(rango.Address).Copy
        h3.Cells(u, "A").PasteSpecial Paste:=xlPasteValues
        h3.Cells(u, "A").PasteSpecial Paste:=xlPasteFormats
        h3.Cells(u, "A").PasteSpecial Paste:=xlPasteColumnWidths
        For i = 1 To rango.Rows.Count
            alto = h2.Rows(i).Height
            h3.Rows(i).RowHeight = alto
        Next
        u = h3.UsedRange.Rows(h3.UsedRange.Rows.Count).Row + 1
        h3.HPageBreaks.Add Before:=h3.Cells(u, "A")
    Next
    '
    ruta = ThisWorkbook.Path & "\"
    h3.ExportAsFixedFormat Type:=xlTypePDF, _
        Filename:=ruta & "empleados.pdf", Quality:=xlQualityStandard, _
        IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False
    h3.Delete
    MsgBox "Archivo empleados.pdf, creado", vbInformation
End Sub

S a l u d o s . D a n t e   A m o r

Recuerda valorar la respuesta.

Hola, buenos días. Está casi perfecto, la única pega es que la primera persona sale perfecta y a partir de la segunda no mantiene el alto de las filas. Te adjunto dos imágenes para que lo veas. Gracias.

Va la macro actualizada

Sub imprime()
'Por.Dante Amor
    Pregunta = MsgBox("Se van a imprimir TODOS los empleados. ¿ESTÁS SEGURO?", _
        vbQuestion + vbYesNo, "¡¡ OJO !!. Importante")
    If Pregunta = 7 Then End
    '
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    Set h1 = Sheets("Planificación anual")
    Set h2 = Sheets("Calendario")
    '
    Set h3 = Sheets.Add
    '
    With h3.PageSetup
        .LeftHeader = ""
        .CenterHeader = ""
        .RightHeader = ""
        .LeftFooter = ""
        .CenterFooter = ""
        .RightFooter = ""
        .LeftMargin = Application.InchesToPoints(0.669291338582677)
        .RightMargin = Application.InchesToPoints(0.47244094488189)
        .TopMargin = Application.InchesToPoints(0.275590551181102)
        .BottomMargin = Application.InchesToPoints(0.354330708661417)
        .HeaderMargin = Application.InchesToPoints(0.15748031496063)
        .FooterMargin = Application.InchesToPoints(0.15748031496063)
        .PrintHeadings = False
        .PrintGridlines = False
        .PrintComments = xlPrintNoComments
        .PrintQuality = 600
        .CenterHorizontally = False
        .CenterVertically = False
        .Orientation = xlLandscape
        .Draft = False
        .PaperSize = xlPaperA4
        .FirstPageNumber = xlAutomatic
        .Order = xlDownThenOver
        .BlackAndWhite = False
        .Zoom = 100
        .PrintErrors = xlPrintErrorsDisplayed
        .OddAndEvenPagesHeaderFooter = False
        .DifferentFirstPageHeaderFooter = False
        .ScaleWithDocHeaderFooter = True
        .AlignMarginsHeaderFooter = True
        .EvenPage.LeftHeader.Text = ""
        .EvenPage.CenterHeader.Text = ""
        .EvenPage.RightHeader.Text = ""
        .EvenPage.LeftFooter.Text = ""
        .EvenPage.CenterFooter.Text = ""
        .EvenPage.RightFooter.Text = ""
        .FirstPage.LeftHeader.Text = ""
        .FirstPage.CenterHeader.Text = ""
        .FirstPage.RightHeader.Text = ""
        .FirstPage.LeftFooter.Text = ""
        .FirstPage.CenterFooter.Text = ""
        .FirstPage.RightFooter.Text = ""
    End With
    '
    For n = 7 To h2.Range("BG3")
        h2.Range("E6") = h1.Range("F" & n)
        'h2.PrintOut Copies:=1, Collate:=True
        u = h3.UsedRange.Rows(h3.UsedRange.Rows.Count).Row + 1
        If u = 2 Then u = 1
        Set rango = Range("A1:AD40")
        h2.Range(rango.Address).Copy
        h3.Cells(u, "A").PasteSpecial Paste:=xlPasteValues
        h3.Cells(u, "A").PasteSpecial Paste:=xlPasteFormats
        h3.Cells(u, "A").PasteSpecial Paste:=xlPasteColumnWidths
        For i = 1 To rango.Rows.Count
            alto = h2.Rows(i).Height
            h3.Rows(u).RowHeight = alto
            u = u + 1
        Next
        u = h3.UsedRange.Rows(h3.UsedRange.Rows.Count).Row + 1
        h3.HPageBreaks.Add Before:=h3.Cells(u, "A")
    Next
    '
    ruta = ThisWorkbook.Path & "\"
    h3.ExportAsFixedFormat Type:=xlTypePDF, _
        Filename:=ruta & "empleados.pdf", Quality:=xlQualityStandard, _
        IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False
    h3.Delete
    MsgBox "Archivo empleados.pdf, creado", vbInformation
End Sub

S a l u d o s . D a n t e   A m o r

Recuerda valorar la respuesta.

Añade tu respuesta

Haz clic para o

Más respuestas relacionadas

¿Cómo combino dos macros que hacen lo que necesito?

Tengo que aplicar dos macros a muchos archivos en excel, Pero es laborioso estar haciendo manualmente algunos procesos para las macros. ¿Cómo fusiono estas dos macros? ¿Se requiere de hacer una nueva macro? Me refiero a las macros de las dos...
1 respuesta

Código para crear botón que guarde e imprima dos recibos de pago diferentes en una hoja.

Quisiera saber algún experto me pudiera ayudar con este problema y le envío el archivo en excel y explico con más detalle.
1 respuesta

Buscar con varias condiciones para crear reporte con Macros

Tengo un libro con 3 hojas, en una de ellas se tienen las variables, en otra los datos y en la tercera se necesita construir el reporte. Hay que traer los conceptos de las celdas C, D y E, según parámetros, a la hoja Reporte. Si motivo es H en la...
1 respuesta

Totalizar 2 columnas para terminar informe con macros

Necesito terminar un informe con macros y me falta totalizar 2 columnas. Un tercer registro a crear sería generar un cálculo entre los 2 columna totalizadas. Se debe crear una línea con el Total de haberes (suma el importe total de haberes). El...
1 respuesta

Quisiera modificar una macro de Dante Amor, para mantener el ancho de columnas en las hojas nuevas.

Según la siguiente macro. ¿Es posible que las hojas nuevas que se van generando, mantengan el ancho de columnas y alto de filas de la primera hoja? También que lo pegado en las hojas nuevas se establezca como área de impresión. Sub CrearyCopiar()...
1 respuesta

Guardar varias hojas de Excel en un mismo PDF con cada nombre de cliente

Tengo hecha una macro que me convierte el excel en PDF (solo de una hoja) y me exporta cada PDF de cada cliente a la ruta que le tengo asignado. Necesito que me convierta la primera y segunda hoja del excel a PDF (el mismo PDF) y que se guarde cada...
1 respuesta

Macro que compare valores de sos libros

Macro Tengo un libro llamado "libro1" de ahí quiero tener el botón para correr la macro quiero que al correrla me abra la ventana para yo seleccionar que archivo abrir de excel que este varia el nombre al momento de abrirlo me filtre por dos...
1 respuesta

Escoger fecha de un combo

Necesito coger la fecha de un combo, osea, poner la fecha y que me devuelva los datos correspondientes a esa fecha De una solapa de un fichero, ahora lo tengo echo pero me sale la fecha como texto y no la encuentro En todoa caso si no fue posible...
1 respuesta

Macro para crear hojas con un nombre y copiar datos en ellas.

Necesito hacer una macro que copie datos e inserte hojas nuevas, apartir de la "Hoja1". En la "Hoja1" tengo una tabla de 14 columnas y 100 filas, La copia se debe de realizar según datos de la columna "A". Al ejecutar la macro, se buscan datos en la...
1 respuesta

Macro para búsqueda y envió de información a proveedores

No soy experta y nececito crear una macro que busque información de proveedores en la primera hoja y en la segunda que busque el correo electrónico y después que mande la información por correo con solo presionar un botón en excel.
1 respuesta