XL 2019 envoyer un onglet par email en format pdf

[gothc]

Bonjour j'ai une macro qui fonctionne bien mais je souhaite avoir le fichier en format en PDF je sais pas si c'est possible

Sub envoi_Feuille()
Application.ScreenUpdating = False
    répertoireAppli = ActiveWorkbook.Path   ' Penser à Outils/Références Outlook
    Sheets("email").Copy       ' onglet
    Application.DisplayAlerts = False
    ActiveWorkbook.SaveAs répertoireAppli & "\email.xls"
    ActiveWindow.Close
    '---  Envoi par mail
    Dim olapp As Outlook.Application
    Sheets("Paramètres_Application").Select
    Range("a3").Select
    
    Do While Not IsEmpty(ActiveCell)
      Dim msg As MailItem
      Set olapp = New Outlook.Application
      Set msg = olapp.CreateItem(olMailItem)
      msg.To = ActiveCell.Value
      msg.Subject = Range("A2").Value
      msg.Body = Range("A5").Value & Chr(13) & Chr(13) & Range("N2").Value & Chr(13) & Range("L2").Value & Chr(13) & Chr(13)
      msg.Attachments.Add Source:=répertoireAppli & "\email.xls"
      msg.Send
      ActiveCell.Offset(1, 0).Select
    Loop
     MsgBox "Email bien envoyé Merci "
End Sub

j'ai fait un test avec

 ActiveWorkbook.SaveAs répertoireAppli & "\email.pdf"

mais impossible ouvrir le fichier Merci de votre aide

 

[patricktoulon]

bonsoir

en pdf on sauve pas on exporte
remplace ceci

 Sheets("email").Copy       ' onglet
    Application.DisplayAlerts = False
    ActiveWorkbook.SaveAs répertoireAppli & "\email.xls"
    ActiveWindow.Close

par cela

Sheets("email").ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
        répertoireAppli & "\email.pdf, Quality:=xlQualityStandard, _
        IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:= _
        False

😉

 

[gothc]

bonsoir

en pdf on sauve pas on exporte
remplace ceci

 Sheets("email").Copy       ' onglet
    Application.DisplayAlerts = False
    ActiveWorkbook.SaveAs répertoireAppli & "\email.xls"
    ActiveWindow.Close

par cela

Sheets("email").ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
        répertoireAppli & "\email.pdf, Quality:=xlQualityStandard, _
        IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:= _
        False

😉

Bonjour bon je sais pas pourquoi mais le code fonctionne pas je fais une copie du code

Sub envoi_Feuille()
Application.ScreenUpdating = False
    répertoireAppli = ActiveWorkbook.Path   ' Penser à Outils/Références Outlook
   Sheets("email").ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
   répertoireAppli & "\email.pdf, Quality:=xlQualityStandard, _IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:= _False"
    '---  Envoi par mail
    Dim olapp As Outlook.Application
    Sheets("Paramètres_Application").Select
    Range("a3").Select
    
    Do While Not IsEmpty(ActiveCell)
      Dim msg As MailItem
      Set olapp = New Outlook.Application
      Set msg = olapp.CreateItem(olMailItem)
      msg.To = ActiveCell.Value
      msg.Subject = Range("A2").Value
      msg.Body = Range("A5").Value & Chr(13) & Chr(13) & Range("N2").Value & Chr(13) & Range("L2").Value & Chr(13) & Chr(13)
      msg.Attachments.Add Source:=répertoireAppli & "\email.xls"
      msg.Send
      ActiveCell.Offset(1, 0).Select
    Loop
     MsgBox "Email bien envoyé Merci "
End Sub

 

[gothc]

Bonjour bon je sais pas pourquoi mais le code fonctionne pas je fais une copie du code

Sub envoi_Feuille()
Application.ScreenUpdating = False
    répertoireAppli = ActiveWorkbook.Path   ' Penser à Outils/Références Outlook
   Sheets("email").ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
   répertoireAppli & "\email.pdf, Quality:=xlQualityStandard, _IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:= _False"
    '---  Envoi par mail
    Dim olapp As Outlook.Application
    Sheets("Paramètres_Application").Select
    Range("a3").Select
   
    Do While Not IsEmpty(ActiveCell)
      Dim msg As MailItem
      Set olapp = New Outlook.Application
      Set msg = olapp.CreateItem(olMailItem)
      msg.To = ActiveCell.Value
      msg.Subject = Range("A2").Value
      msg.Body = Range("A5").Value & Chr(13) & Chr(13) & Range("N2").Value & Chr(13) & Range("L2").Value & Chr(13) & Chr(13)
      msg.Attachments.Add Source:=répertoireAppli & "\email.xls"
      msg.Send
      ActiveCell.Offset(1, 0).Select
    Loop
     MsgBox "Email bien envoyé Merci "
End Sub

 

[gothc]

Application.ScreenUpdating = False

    répertoireAppli = ActiveWorkbook.Path   ' Penser à Outils/Références Outlook

   Sheets("email").ExportAsFixedFormat Type:=xlTypePDF, Filename:= _

   répertoireAppli & "\email.pdf, Quality:=xlQualityStandard, _IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:= _False"

j'ai le code en jaune