Macro para enviar Email con 2 rangos en PDF
Tengo un problem que no se como solucionar, tengo una macro para enviar un email con PDF adjunto, donde el problema, necesito que me convierta a pdf dos rangos de la misma y los adjunte al correo en forma automatica.
Ejemplos ... Hoja1 - Rango A1 a C3 en pdf y adicional Rango A10 a C20, convertir y adjuntar en pdf, adjunto el código armado sobre el que trabajo, de antemano, gracias! ;D
Sub Mail_Informe()
ActiveWorkbook. Save
ActiveSheet. Unprotect "0123" 'Desactivo Clave (pass)
Dim OutMail As Object 'Se crea la conexión con el gestor de correo
Set OutApp = CreateObject("Outlook.Application")
OutApp.Session.logon
Set OutMail = OutApp.CreateItem(0) 'Se crea metodo de envio de correo
On Error Resume Next
Application.Dialogs(xlDialogPrinterSetup).Show 'Selecciono la Impresora
Rows("14:119").Hidden = False 'Muestra Filas Ocultas
wpath = ThisWorkbook.Path & "\"
Nombre = Range("C10")
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, _
Filename:=wpath & Nombre & ".pdf", _
Quality:=xlQualityStandard, _
IncludeDocProperties:=True, _
IgnorePrintAreas:=False, _
OpenAfterPublish:=False
With OutMail
'Application.Wait Now + TimeValue("00:00:03")
.To = Range("E3").Value
.CC = Range("E5").Value
.BCC = Range("E6").Value
.Subject = Range("E7").Value
.Attachments.Add wpath & Nombre & ".pdf" 'muestra
. Attachments. Add ad
Range("B9:U60"). CopyPicture 'Rango a Copiar
. Display 'El correo se muestra
DoEvents
Application. Wait Now + TimeValue("00:00:02") 'Timer para ejecutar
SendKeys "^{END}", True
SendKeys "^v", True '"Ctrl + v" (Pegado)
DoEvents
Application.SendKeys "{NUMLOCK}" 'Activo el boton de Bloq/Numerico
.Display
'.Send
End With
On Error GoTo 0
Set OutMail = Nothing
Set OutApp = Nothing
'SendKeys ("{ESC}")
Call Volver_Inicio
End Sub
