XL 2019 envoyer un onglet par email en format pdf

gothc

XLDnaute Occasionnel
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
VB:
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
Code:
 ActiveWorkbook.SaveAs répertoireAppli & "\email.pdf"
mais impossible ouvrir le fichier Merci de votre aide
 

patricktoulon

XLDnaute Barbatruc
bonsoir

en pdf on sauve pas on exporte
remplace ceci
VB:
 Sheets("email").Copy       ' onglet
    Application.DisplayAlerts = False
    ActiveWorkbook.SaveAs répertoireAppli & "\email.xls"
    ActiveWindow.Close
par cela
VB:
Sheets("email").ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
        répertoireAppli & "\email.pdf, Quality:=xlQualityStandard, _
        IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:= _
        False
;)
 

gothc

XLDnaute Occasionnel
bonsoir

en pdf on sauve pas on exporte
remplace ceci
VB:
 Sheets("email").Copy       ' onglet
    Application.DisplayAlerts = False
    ActiveWorkbook.SaveAs répertoireAppli & "\email.xls"
    ActiveWindow.Close
par cela
VB:
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
VB:
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

XLDnaute Occasionnel
Bonjour bon je sais pas pourquoi mais le code fonctionne pas je fais une copie du code
VB:
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

XLDnaute Occasionnel
Code:
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
 

Discussions similaires

Statistiques des forums

Discussions
311 729
Messages
2 081 971
Membres
101 852
dernier inscrit
dthi16088