XL 2021 choisir un onglet avant envoyer par email

[gothc]

Bonjour je souhaite pouvoir choisir l'onglet a envoyer dans mon email via outlook
j'ai une macro de base qui fonctionne pour l'envoi si dessous merci pour votre aide
pourquoi pas a l'aide d'une liste déroulante via un onglet pour choisir par exemple
merci de votre aide et vos idées

 ThisWorkbook.Save
' Nécessite la référence : Microsoft Outlook 1x Object Library
Dim olApp As Outlook.Application
Dim olMail As MailItem
Dim CurFile As String

Set olApp = New Outlook.Application
Set olMail = olApp.CreateItem(olMailItem)
' "C:\Users\Thierry\AppData\Local\Temp\MaFeuille.pdf "
CurFile = ThisWorkbook.Path & "\" & "feuil1.Pdf"
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=CurFile, _
Quality:=xlQualityStandard, IncludeDocProperties:=False, IgnorePrintAreas:=False, _
OpenAfterPublish:=False
With olMail

.To = "tonemail@gmail.com"
.CC = ""
.Subject = "test"
.Body = "Vous trouverez ci-joint le fichier PDF du test "
.Attachments.Add CurFile
'.Attachments.Add "c:\My Documents\book.doc"
.Send '.Display '
End With
MsgBox "message bien envoyé."
 
' Effacer les variables objets
Set olMail = Nothing
Set olApp = Nothing
End Sub

 

[kiki29]

Salut, voir sur le site de Ron de Bruin

 

[gothc]

ub EnvoyerEmailAvecFeuilleEtPDF()
    Dim olApp As Object
    Dim olMail As Object
    Dim CurFile As String
    
    Dim ChosenTab As String
    Dim ExcelWorksheet As Object
    
    ChosenTab = InputBox("Choisissez l'onglet à envoyer :", "Choix de l'onglet")
    
    ' Vérifiez que l'onglet existe
    On Error Resume Next
    Set ExcelWorksheet = ThisWorkbook.Sheets(ChosenTab)
    On Error GoTo 0
    
    If ExcelWorksheet Is Nothing Then
        MsgBox "L'onglet spécifié n'existe pas dans ce classeur.", vbExclamation
        Exit Sub
    End If
    
    ThisWorkbook.Save
    
    ' Chemin du fichier PDF à générer
    CurFile = ThisWorkbook.Path & "\" & "Résultat de l'animation.pdf"
    
    ' Générer le PDF
    ExcelWorksheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=CurFile, _
        Quality:=xlQualityStandard, IncludeDocProperties:=False, IgnorePrintAreas:=False, _
        OpenAfterPublish:=False
    
    ' Créer l'objet Outlook
    Set olApp = CreateObject("Outlook.Application")
    Set olMail = olApp.CreateItem(0) ' 0 correspond à un nouveau mail
    
    ' Configure l'e-mail
    With olMail
        .To = "ton email"
        .CC = ""
        .Subject = "Résultat de l'animation"
        .Body = "Vous trouverez ci-joint le fichier PDF du Résultat de l'animation."
        .Attachments.Add CurFile
        '.Send '.Display '
        .Send ' Pour afficher le brouillon de l'e-mail
    End With
    
    MsgBox "Message bien envoyé."
    
    ' Nettoie
    Set olMail = Nothing
    Set olApp = Nothing
End Sub

j'ai reçu une réponse de GPT QUI FONCTIONNE