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.