Cómo hago para que este macro de Excel en vez de imprimir guarde en archivo PDF de forma compilada?

Comparto código que que tome de internet.

Sub ImprimirNotas()
'validaciones
Set h = Sheets("Indicadores + Imprimir")
hoja = h.[B4]
col = h.[B5]
fila = h.[B6]
plan = h.[B7]
celda = h.[B8]
'
res = Validaciones(hoja, col, fila, plan, celda)
If res <> "" Then
MsgBox res, vbExclamation, "IMPRIMIR PLANTILLA DE EXCEL"
Range("B4").Select
Exit Sub
End If
'
Set h1 = Sheets(hoja)
Set h2 = Sheets(plan)
For i = fila To h1.Range(col & Rows.Count).End(xlUp).Row
h2.Range(celda) = h1.Cells(i, col)
h2.PrintOut
Next
MsgBox "Impresión Terminada", vbInformation, "IMPRIMIR PLANTILLA DE EXCEL"
End Sub
'
Function Validaciones(hoja, col, fila, plan, celda)
'Por.Dante Amor
msg = ""
If hoja = "" Then
msg = "Completa la hoja con datos"
Else
existe = False
For Each h In Sheets
If LCase(h.Name) = LCase(hoja) Then
existe = True
Exit For
End If
Next
If existe = False Then
msg = "La hoja con la base de datos no existe"
End If
End If
If col = "" Then
msg = "Completa la columna de datos"
End If
If fila = "" Then
msg = "Completa la fila inicial de los datos"
End If
If plan = "" Then
msg = "Completa la hoja plantilla"
Else
existe = False
For Each h In Sheets
If LCase(h.Name) = LCase(plan) Then
existe = True
Exit For
End If
Next
If existe = False Then
msg = "La hoja con la plantilla no existe"
End If
End If
If celda = "" Then
msg = "Completa la celda destino"
End If
Validaciones = msg
End Function

1 Respuesta

Respuesta
1

A qué te refieres con

Guarde en archivo PDF de forma compilada

¿Quieres qué cada hoja se guarde como un archivo? ¿Si es así qué nombre va a llevar cada archivo?

Sí señor que cada hoja de vuelva un archivo PDF y que pida dónde guardarlo. 

Otra sería que uniera todas las hojas en archivo PDF y pida guardar dónde.

Gracias

¿Cuál quieres?

¿Un archivo por cada hoja? ¿Cómo se van a llamar cada archivo?

¿O un archivo con todas las hojas? ¿Cómo se va a llamar el archivo?

Podemos ahorrarnos lo de que te pida dónde guardar y te guarde el archivo en la misma carpeta donde tienes el archivo con la macro.

¿O un archivo con todas las hojas?

-Respuesta: SÍ, un archivo con todas las hojas

¿Cómo se va a llamar el archivo? 

-Boletines 

Podemos ahorrarnos lo de que te pida dónde guardar y te guarde el archivo en la misma carpeta donde tienes el archivo con la macro.

Respuesta: SÍ

Sí puede hacer esas dos funciones te estaría muy agradecido.

Te anexo la macro

Sub ImprimirNotas()
'
'   Por Dante Amor
'
    '
    'Genera una hoja por cada dato
    'Envía todas las hojas a un archivo PDF
    '
    'validaciones
    Set h = Sheets("Indicadores + Imprimir")
    hoja = h.[B4]
    col = h.[B5]
    fila = h.[B6]
    plan = h.[B7]
    celda = h.[B8]
    '
    res = Validaciones(hoja, col, fila, plan, celda)
    If res <> "" Then
        MsgBox res, vbExclamation, "IMPRIMIR PLANTILLA DE EXCEL"
        Range("B4").Select
        Exit Sub
    End If
    '
    n = Application.SheetsInNewWorkbook
    Application.DisplayAlerts = False
    Application.ScreenUpdating = False
    Application.SheetsInNewWorkbook = 1
    '
    Set h1 = Sheets(hoja)
    Set h2 = Sheets(plan)
    Set l2 = Workbooks.Add
    For i = fila To h1.Range(col & Rows.Count).End(xlUp).Row
        h2.Range(celda) = h1.Cells(i, col)
        h2.Copy after:=l2.Sheets(l2.Sheets.Count)
    Next
    l2.Sheets(1).Delete
    ruta = ThisWorkbook.Path & "\"
    arch = "Boletines.pdf"
    l2.ExportAsFixedFormat Type:=xlTypePDF, _
        Filename:=ruta & arch, _
        Quality:=xlQualityStandard, IncludeDocProperties:=True, _
        IgnorePrintAreas:=False, OpenAfterPublish:=False
    l2.Close False
    Application.SheetsInNewWorkbook = n
    Application.ScreenUpdating = True
    MsgBox "Achivo PDF creado", vbInformation, "PLANTILLA DE EXCEL"
End Sub
'
Function Validaciones(hoja, col, fila, plan, celda)
'Por.Dante Amor
    msg = ""
    If hoja = "" Then
        msg = "Completa la hoja con datos"
    Else
        existe = False
        For Each h In Sheets
            If LCase(h.Name) = LCase(hoja) Then
                existe = True
                Exit For
            End If
        Next
        If existe = False Then
            msg = "La hoja con la base de datos no existe"
        End If
    End If
    If col = "" Then
        msg = "Completa la columna de datos"
    End If
    If fila = "" Then
        msg = "Completa la fila inicial de los datos"
    End If
    If plan = "" Then
        msg = "Completa la hoja plantilla"
    Else
        existe = False
        For Each h In Sheets
            If LCase(h.Name) = LCase(plan) Then
                existe = True
                Exit For
            End If
        Next
        If existe = False Then
            msg = "La hoja con la plantilla no existe"
        End If
    End If
    If celda = "" Then
        msg = "Completa la celda destino"
    End If
    Validaciones = msg
End Function

'.[Sal u dos. Dante Amor. No olvides valorar la respuesta. 

¡Gracias! 

Sale un error esta línea de código

l2.ExportAsFixedFormat Type:=xlTypePDF, _
        FileName:=ruta & arch, _
        Quality:=xlQualityStandard, IncludeDocProperties:=True, _
        IgnorePrintAreas:=False, OpenAfterPublish:=False

y el archivo lo abre pero como de excel no PDF

¿Qué mensaje de error te aparece?

¿Tienes en tu versión de excel la opción para guardar archivos a PDF?

Activa la grabadora de macros en excel, guarda el archivo como PDF, regresa a detener la grabadora de macros, el código que te genera pégalo a quí para revisarlo.

Añade tu respuesta

Haz clic para o

Más respuestas relacionadas