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.