XL 2019 envoyer un onglet par email en format pdf

patricktoulon à dit:

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

Cliquez pour agrandir...

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 à dit:

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

Cliquez pour agrandir...