Imprimir hojas de excel en PDF y enviar por correo

Dispongo de este código

Sub ImprimirReporte()
    Call enviar_PDF("SendEmail")
End Sub
Function enviar_PDF(Optional action As String = "SaveOnly") As Boolean ' Copia las hojas en un nuevo archivo PDF para enviarlo por correo electrónico
    Dim hoja As String, archivo As String, ruta As String
    Dim guardarComo As String
Application.ScreenUpdating = False
' Obtener el nombre del archivo guardado
    hoja = hoja5.Range("A15").Value
    archivo = ActiveWorkbook.Name
    ruta = ActiveWorkbook.Path
    guardarComo = ruta & "\" & hoja & ".pdf"
'Establecer la calidad de impresión
    On Error Resume Next
    ActiveSheet.PageSetup.PrintQuality = 600
    Err.Clear
    On Error GoTo 0
' Indicar al usuario cómo enviar
    On Error GoTo RefLibError
    ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=guardarComo, Quality:=xlQualityStandard, IncludeDocProperties:=False, IgnorePrintAreas:=False, OpenAfterPublish:=True
    On Error GoTo 0
' Enviar correo electrónico
    If action = "SendEmail" Then
        On Error GoTo SaveOnly
        Set olApp = CreateObject("Outlook.Application")
        Set olEmail = olApp.CreateItem(olMailItem)
        With olEmail
            .Subject = hoja & ".pdf"
            .Attachments.Add guardarComo
            .Display
        End With
        On Error GoTo 0
        GoTo EndMacro
    End If
SaveOnly:
    MsgBox "Se ha guardado correctamente una copia de esta hoja como archivo .pdf: " & vbCrLf & vbCrLf & guardarComo & _
        "Revise el documento .pdf. Si el documento NO se ve bien, ajuste los parámetros de impresión e inténtelo de nuevo."
    Send_PDF = True
    GoTo EndMacro
RefLibError:
    MsgBox "Imposible guardar como PDF. No se ha encontrado la biblioteca de referencia"
    Send_PDF = False
EndMacro:
End Function

Me permite guardar en PDF y luego enviar por correo, pero necesito que sea más de una hoja e intentado modificar el código, pero me crea la mima hoja.

Añade tu respuesta

Haz clic para o