Envoi en PDF un fichier Excel

Hello,

Je n'arrive pas envoyer un fichier que j'enregistre en PDF.

A savoir que j'utilise Teams respectivement Sharepoint pour ce fichier.

Voici mes VBA

Sub Enreg_05()
Dim LaDate$, Nom$, Cheminjournée$ 'Déclaration des variables
LaDate = Format(Range("A1"), "yymmdd") 'formatage de la date
Nom = "réserve bus" 'Nom de l'onglet à entregistrer
Cheminjournée = " https:// YYYYYY.sharepoint .com/sites/XXX" ' Chemin du répertoire à adapter depuis votre PC
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
Cheminjournée & LaDate & "_" & Nom & ".pdf", Quality:= _
xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, _
From:=1, To:=10, OpenAfterPublish:=False 'enregistrement du fichier en PDF

Sub Envoi()

Dim FileExtStr As String
Dim FileFormatNum As Long
Dim Sourcewb As Workbook
Dim destwb As Workbook
Dim TempFilePath As String
Dim TempFileName As String
Dim OutApp As Object
Dim OutMail As Object
Dim S As Shape

With Application
.ScreenUpdating = False
.EnableEvents = False
End With

Set Sourcewb = ActiveWorkbook

'Copie la feuille active comme nouvelle feuille

ActiveSheet.Copy
Set destwb = ActiveWorkbook

'Désactiver fenêtre de compatibilité
Application.DisplayAlerts = False
'----------------------------------------------------------------------------
'Sauvegarde la nouvelle feuille/L'envoie par mail/La supprime
'----------------------------------------------------------------------------

LaDate = Format(Range("A1"), "yymmdd") 'formatage de la date
Nom = "réserves bus" 'Nom de l'onglet à entregistrer
Chemin = "C:\Dossier en transfert\"

Set OutApp = CreateObject("outlook.application")
Set OutMail = OutApp.CreateItem(0)

With destwb
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
Chemin & LaDate & "_" & Nom & ".pdf", Quality:= _
xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, _
From:=1, To:=10, OpenAfterPublish:=False 'enregistrement du fichier en PDF

On Error Resume Next
With OutMail
.To = "repartition@mbc.ch"
.Subject = "Attribution des réserves - " & Range("A1")
.SentOnBehalfOfName = "<XXXXXX@XXXXXXX.XXXXXX>"
.Body = "Bonjour," & vbCrLf & "Vous trouverez en pièce jointe l'attribution des réserves du jour " & vbCrLf & "" & vbCrLf & "Meilleures salutations" & vbCrLf & "ZZZZZZZZZZ"
.Attachments.Add Chemin & LaDate & "_" & Nom & ".pdf"
.display
.Send

End With
On Error GoTo 0
.Close SaveChanges:=False
End With

'Effacer le fichier envoyé
Kill Chemin & LaDate & "_" & Nom & ".pdf"

Set OutMail = Nothing
Set OutApp = Nothing

With Application
.ScreenUpdating = True
.EnableEvents = True
End With

End Sub

Merci du coup de main

Bonjour Flacs,

Merci de mettre le code entre balises avec le bouton </> (comme je viens de le faire)