XL 2019 Envoyer une feuille par mail en pdf

Bonjour Lolote83, le forum
avec plaisir, voici la solution pour un envoi en CDO, mais je ne sais pas utiliser les balises et je suis sur qu'il y a quelques erreurs, mais cela fonctionne bien

Option Explicit
Public Const ParamSendUsing As String = "http://schemas.microsoft.com/cdo/configuration/sendusing"
Public Const ParamServeur As String = "http://schemas.microsoft.com/cdo/configuration/smtpserver"
Public Const ParamPort As String = "http://schemas.microsoft.com/cdo/configuration/smtpserverport"
Public Const ParamIdentificateur As String = "http://schemas.microsoft.com/cdo/configuration/smtpauthenticate"
Public Const ParamIdentifiant As String = "http://schemas.microsoft.com/cdo/configuration/sendusername"
Public Const ParamMotDePasse As String = "http://schemas.microsoft.com/cdo/configuration/sendpassword"
Public Const ParamSsl As String = "http://schemas.microsoft.com/cdo/configuration/smtpusessl"

Sub EnvoiMailCDO()
Dim CdoMessage, CdoConfig, CdoParam
'Dim Fichier As String
Dim Var1 As String ' nom
Dim Chemin As String 'chemin du fichier
Dim NFichier As String 'Nom du fichier
Dim titre As String
Dim strbody As String
Var1 = [D6].Value 'Nom du client : exemple ==> Dupont
If Var1 = Empty Then
MsgBox "Veuillez préciser le nom et le prénom.", vbYes, "PL"
Exit Sub
End If
Application.ScreenUpdating = False
Dim Sh1 As Worksheet
Set Sh1 = Feuil5 'A adapter si besoin en fonction du codename de la feuille 1
With Sh1.PageSetup
.PrintArea = "A1:N115" 'Zone d'impression à adapter de la feuille 1
.Zoom = False
.FitToPagesWide = 3
.FitToPagesTall = 3
'Réglage des marges
.LeftMargin = Application.InchesToPoints(1.2) 'Marge gauche
.RightMargin = Application.InchesToPoints(0.1) 'Marge droite
.TopMargin = Application.InchesToPoints(0.5) 'Marge haut de page
.BottomMargin = Application.InchesToPoints(0.1) 'Marge bas de page
.Orientation = xlLandscape 'Paysage ' .Orientation = xlPortrait 'Portrait
End With
Sheets(Array(Sh1.name)).Select

Chemin = Application.ActiveWorkbook.Path ' 'direction du fichier pdf
'If Dir(Chemin, vbDirectory) = "" Then MkDir Chemin

NFichier = ThisWorkbook.Path & "\" & "PROSPECT" & "-" & Sh1.Range("h3") & "-" & Format(Date, "dd-mm-yyyy") & ".pdf" 'Création du fichier pdf
'Création du fichier PDF
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, FileName:=NFichier, Quality _
:=xlQualityMinimum, IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False
Set CdoConfig = CreateObject("CDO.Configuration")

CdoConfig.Load -1
Set CdoParam = CdoConfig.Fields

With CdoParam
.Item(ParamSendUsing) = 2
.Item(ParamServeur) = [T9].Value
.Item(ParamPort) = [T10].Value
.Item(ParamIdentificateur) = "1"
.Item(ParamIdentifiant) = [T12].Value 'Votre Identifiant
.Item(ParamMotDePasse) = [T13].Value 'Votre mot de passe
.Item(ParamSsl) = "true"
.Update
End With

Set CdoMessage = CreateObject("CDO.Message")
With CdoMessage
Set .Configuration = CdoConfig
.From = [T4].Value
.To = [T5].Value
.CC = [T6].Value 'destinataires en copie (CC)
.BCC = [T7].Value 'destinataires en copie cachée (CCI)
.Subject = titre & " " & [H3] 'sujet
.TextBody = strbody

strbody = "Bonjour," & vbNewLine & vbNewLine & "veuillez trouver ci-joint le relevé d'information de " & [D5] & " " & [H3] & vbNewLine & vbNewLine
strbody = strbody & "Cordialement" & vbNewLine & vbNewLine
strbody = strbody & "Service commercial" & " : " & [T3]

.Fields("urn:schemas:mailheader:disposition-notification-to") = [T4].Value
.Fields("urn:schemas:mailheader:return-receipt-to") = [T4].Value
.Fields.Update
.AddAttachment NFichier
.Send
End With
MsgBox "Le relevé a bien été envoyé !"
Kill NFichier
Set CdoMessage = Nothing
Set CdoConfig = Nothing
Set CdoParam = Nothing
Set Sh1 = Nothing 'Decharge la feuille 1
Application.ScreenUpdating = True
End Sub

Pat66