Dar nombre a PDF para enviar por email

[Maku]

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!

Editado el el 1 de junio por Maku

[Maku]

Poco a poco voy prosperando (es este archivo o yo 🤪), he hecho un ejemplo con lo que creo que está mejor, pero no consigo hacer el envío del correo.

Adjunto archivo que tiene dos macros:

- Para imprimir la semana 1

- Para imprimir la semana 2

Necesito una macro que me lance esas otras dos macros y adjunte los pdf en un email.

Muchas gracias por la ayuda.

 

Para macro.xlsm

Editado el el 5 de junio por Maku