Sub EnvioDatosVend()
Dim narch As String
Dim cliente As String
Dim mail As String
Dim Ruta As String
Dim libro As String
Dim ahora As String
Dim vend As String
Dim ArchivoPdf As String
Dim ImpresoraAct As String
Dim ProgCorreo As Object
Dim CorreoSaliente As Object
With Application
.ScreenUpdating = False
.EnableEvents = False
.DisplayAlerts = False
End With
ImpresoraAct = Application.ActivePrinter
Application.Dialogs(xlDialogPrinterSetup).Show
Sheets("Horarios").Select
narch = Range("G54")
cliente = Range("V3")
mail = Range("C55")
vend = Range("C54")
Ruta = "C:\temp\"
ahora = Application.WorksheetFunction.Text(Now(), "dd.mm.yy")
libro = narch & " " & vend & " " & cliente & ".pdf"
ArchivoPdf = Ruta & libro
Set ProgCorreo = CreateObject("Outlook.Application")
Set CorreoSaliente = ProgCorreo.CreateItem(0)
With ActiveSheet
.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
ArchivoPdf, Quality _
:=xlQualityStandard, IncludeDocProperties:=False, IgnorePrintAreas:=False _
, OpenAfterPublish:=False
End With
On Error Resume Next
With CorreoSaliente
.To = mail
.CC = ""
.BCC = ""
.Subject = narch & " " & vend & " " & cliente
.body = "Hola " & vend & Chr(13) & "Te mando el horario del mes." & Chr(13) & "Un saludo."
.Attachments.Add ArchivoPdf
.Send
End With
On Error GoTo 0
Set CorreoSaliente = Nothing
Set ProgCorreo = Nothing
With Application
.ScreenUpdating = True
.EnableEvents = True
.DisplayAlerts = True
End With
El otro pdf funciona de forma similar, pero no consigo saber donde nombrar el archivo al crear los .pdf ni donde indicar en las macros de envío que es uno u otro el que quiero enviar.
Funcionar, milagrosamente, funcionan, pero siempre me envía el mismo PDF
Está claro que no tengo idea de cómo realizar macros, lo intento a base de ideas que encuentro y de prueba y error, pero se me está resistiendo.
¿Podéis ayudarme?
Gracias!
Featured Replies
Archivado
Este tema está ahora archivado y está cerrado a más respuestas.
Buenas tardes.
He hecho dos macros que imprimen dos pdf de diferentes páginas.
Primero hago el pdf:
Sub printdep() Dim nombre As String, Ruta As String, nombre2 As String Sheets("Horarios").Select Range("A1:Q42").Select ActiveSheet.PageSetup.PrintArea = "$A$1:$Q$42" Application.PrintCommunication = False With ActiveSheet.PageSetup .PrintTitleRows = "" .PrintTitleColumns = "" End With Application.PrintCommunication = True ActiveSheet.PageSetup.PrintArea = "$A$1:$Q$42" Application.PrintCommunication = False With ActiveSheet.PageSetup .LeftHeader = "" .CenterHeader = "" .RightHeader = "" .LeftFooter = "" .CenterFooter = "" .RightFooter = "" .LeftMargin = Application.InchesToPoints(1.7) .RightMargin = Application.InchesToPoints(0) .TopMargin = Application.InchesToPoints(0.2) .BottomMargin = Application.InchesToPoints(0.2) .HeaderMargin = Application.InchesToPoints(0.31496062992126) .FooterMargin = Application.InchesToPoints(0.31496062992126) .PrintHeadings = False .PrintGridlines = False .PrintComments = xlPrintNoComments .CenterHorizontally = False .CenterVertically = False .Orientation = xlLandscape .Draft = False .PaperSize = xlPaperA4 .FirstPageNumber = xlAutomatic .Order = xlDownThenOver .BlackAndWhite = False .Zoom = False .FitToPagesWide = 1 .FitToPagesTall = 1 .PrintErrors = xlPrintErrorsDisplayed .OddAndEvenPagesHeaderFooter = False .DifferentFirstPageHeaderFooter = False .ScaleWithDocHeaderFooter = True .AlignMarginsHeaderFooter = True .EvenPage.LeftHeader.Text = "" .EvenPage.CenterHeader.Text = "" .EvenPage.RightHeader.Text = "" .EvenPage.LeftFooter.Text = "" .EvenPage.CenterFooter.Text = "" .EvenPage.RightFooter.Text = "" .FirstPage.LeftHeader.Text = "" .FirstPage.CenterHeader.Text = "" .FirstPage.RightHeader.Text = "" .FirstPage.LeftFooter.Text = "" .FirstPage.CenterFooter.Text = "" .FirstPage.RightFooter.Text = "" End With Application.PrintCommunication = True Application.PrintCommunication = False With ActiveSheet.PageSetup .PrintTitleRows = "" .PrintTitleColumns = "" ThisWorkbook.ActiveSheet.PrintOut Application.PrintCommunication = True Sheets("HORARIOS").Select End With
Y lo envia:
Sub EnvioDatosVend() Dim narch As String Dim cliente As String Dim mail As String Dim Ruta As String Dim libro As String Dim ahora As String Dim vend As String Dim ArchivoPdf As String Dim ImpresoraAct As String Dim ProgCorreo As Object Dim CorreoSaliente As Object With Application .ScreenUpdating = False .EnableEvents = False .DisplayAlerts = False End With ImpresoraAct = Application.ActivePrinter Application.Dialogs(xlDialogPrinterSetup).Show Sheets("Horarios").Select narch = Range("G54") cliente = Range("V3") mail = Range("C55") vend = Range("C54") Ruta = "C:\temp\" ahora = Application.WorksheetFunction.Text(Now(), "dd.mm.yy") libro = narch & " " & vend & " " & cliente & ".pdf" ArchivoPdf = Ruta & libro Set ProgCorreo = CreateObject("Outlook.Application") Set CorreoSaliente = ProgCorreo.CreateItem(0) With ActiveSheet .ExportAsFixedFormat Type:=xlTypePDF, Filename:= _ ArchivoPdf, Quality _ :=xlQualityStandard, IncludeDocProperties:=False, IgnorePrintAreas:=False _ , OpenAfterPublish:=False End With On Error Resume Next With CorreoSaliente .To = mail .CC = "" .BCC = "" .Subject = narch & " " & vend & " " & cliente .body = "Hola " & vend & Chr(13) & "Te mando el horario del mes." & Chr(13) & "Un saludo." .Attachments.Add ArchivoPdf .Send End With On Error GoTo 0 Set CorreoSaliente = Nothing Set ProgCorreo = Nothing With Application .ScreenUpdating = True .EnableEvents = True .DisplayAlerts = True End With
El otro pdf funciona de forma similar, pero no consigo saber donde nombrar el archivo al crear los .pdf ni donde indicar en las macros de envío que es uno u otro el que quiero enviar.
Funcionar, milagrosamente, funcionan, pero siempre me envía el mismo PDF
Está claro que no tengo idea de cómo realizar macros, lo intento a base de ideas que encuentro y de prueba y error, pero se me está resistiendo.
¿Podéis ayudarme?
Gracias!