Envoi et Nommé Onglet en PDF via Outlook (Mail)

Question

Bonjour, j'ai réussi à trouver une macro qui me permet d'envoyer un email sous OUTLOOK avec en pièce jointe l'onglet actif transformé en PDF et nommé "TR_date du jour", mais j'aimerais que cette macro continue à transformer l'onglet en PDF et qu'elle renomme l'onglet par "TR_nom de l'onglet".

Voici la macro

Sub Mail()
Dim FileExtStr As String
Dim FileFormatNum As Long
Dim Sourcewb As Workbook
Dim destwb As Workbook
Dim TempFilePath As String
Dim TempFileName As String, nomfeuille As String
Dim OutApp As Object
Dim OutMail As Object
Dim S As Shape
Dim sNomFic As String, sRep As String, WshShell As Object

If ThisWorkbook.Worksheets("MODEL").Cells(34, 7) <> "" Then
    nomfeuille = Format(Day(ThisWorkbook.Worksheets("MODEL").Cells(34, 7).Value), "00") + "_TR"
Else
    nomfeuille = Format(Day(Date), "00") + "_TR"
End If
If FeuilleExiste(nomfeuille) Then
    If MsgBox("Attention la feuille " & nomfeuille & " existe deja !!" & Chr(10) & Chr(10) & "Voulez-vous la supprimer ?", vbYesNo) = vbNo Then
        Exit Sub
    End If
End If

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

' Creer une instance Windows Script pour retrouver le chemin du bureau
Set WshShell = CreateObject("WScript.Shell")
sRep = WshShell.SpecialFolders("Desktop")
Set WshShell = Nothing
' Definit le nom du fichier _ enregistrer
sNomFic = "TR" & Format(Date, "yyyymmdd") & ".PDF"
' Enregistrer la feuille en PDF
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=sRep & "\" & sNomFic, _
Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, _
OpenAfterPublish:=False

Set OutApp = CreateObject("outlook.application")
Set OutMail = OutApp.CreateItem(0)
    With OutMail
        .To = ""
        .CC = ""
        .Attachments.Add (sRep & "\" & sNomFic)
        .Subject = "XXXXX"
        .body = "A YYYY, le " & Format(Date, "dd/mm/yy") & vbCrLf & vbCrLf
        .body = .body & "Bonjour," & vbCrLf & vbCrLf
        .body = .body & "Je vous prie de trouver, ci-joint, ." & vbCrLf & vbCrLf
        .body = .body & "Bien cordialement," & vbCrLf & vbCrLfff
        .Display
'        .Send 'envoi automatique
    End With

With Application
    .ScreenUpdating = True
    .EnableEvents = True
End With
'Kill (sRep & "\" & sNomFic)
Historiser

End Sub

Pensez-vous que cela soit possible

Invité · Accepted Answer

Ca se passe ici ' Definit le nom du fichier _ enregistrer sNomFic = "TR" & Format(Date, "yyyymmdd") ' Renommer l'onglet ActiveSheet.Name = sNomFic ' Enregistrer la feuille en PDF ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=sRep & "\" & sNomFic & ".pdf", _ Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, _ OpenAfterPublish:=False A+...