Changer le nom de la pièce jointe

Bonjour,

Je tente de faire quelque chose que me parâit impossible :

Dans mon fichier, j'ai créé un module me permettant d'enregistrer automatiquement le fichier dont le nom correspond à la valeur d'une cellule, voici le code :

Sub enregistrer_classeur()
Dim chemin As String, fichier As String
chemin = ThisWorkbook.Path
fichier = chemin & "\" & Range("D14") & ".xls"
ActiveWorkbook.SaveAs Filename:=fichier
End Sub

Dans un second module activé par le même bouton, j'ai ce code :

Sub transpose_dans_tableau()
Call enregistrer_classeur
Dim ligne_active_base As Double
Sheets("Feuil1").Activate
If Range("A2").Value = "" Then
ligne_active_base = Range("A2").Row
Else
ligne_active_base = Range("A65000").End(xlUp).Row + 1
End If
Sheets("Formulaire").Range("D14").Copy
Range("A" & ligne_active_base).PasteSpecial Paste:=xlPasteAllExceptBorders, Operation:=xlNone, SkipBlanks:=False, Transpose:=True
Application.CutCopyMode = False
Sheets("Formulaire").Range("D16").Copy
Range("B" & ligne_active_base).PasteSpecial Paste:=xlPasteAllExceptBorders, Operation:=xlNone, SkipBlanks:=False, Transpose:=True
Application.CutCopyMode = False
Sheets("Formulaire").Range("D19").Copy
Range("C" & ligne_active_base).PasteSpecial Paste:=xlPasteAllExceptBorders, Operation:=xlNone, SkipBlanks:=False, Transpose:=True
Application.CutCopyMode = False
Sheets("Formulaire").Range("D22").Copy
Range("D" & ligne_active_base).PasteSpecial Paste:=xlPasteAllExceptBorders, Operation:=xlNone, SkipBlanks:=False, Transpose:=True
Application.CutCopyMode = False
Sheets("Formulaire").Range("D24").Copy
Range("E" & ligne_active_base).PasteSpecial Paste:=xlPasteAllExceptBorders, Operation:=xlNone, SkipBlanks:=False, Transpose:=True
Application.CutCopyMode = False
Sheets("Formulaire").Select
Call Mail_workbook_Outlook_1
End Sub

Et donc en toute logique puisque je l'ai appelé précédemment, le module suivant doit générer un mail :

Sub Mail_workbook_Outlook_1()
If UCase(Sheets("Formulaire").Range("G21")) <> "" Then
    Set outapp = CreateObject("Outlook.Application")
        Set outmail = outapp.CreateItem(0)
        With outmail
            '   .From = ("****************@**************.fr")
            .To = (Sheets("Formulaire").Range("G21").Value)
            .Subject = "Nouveau Dossier Revue de Contrat"
            .Body = "TEST"
            .Attachments.Add ActiveWorkbook.Path &  "\revue.xls"    
 .Display
        End With
        Set outapp = Nothing
End If
End Sub

Mon problème c'est que je voudrais que le fichier soit envoyé sous le nom sous lequel il a été enregistré et pas sous un nom fixe "revue.xls".

J'ai essayé par mal de possibilités mais je suis à bout d'idées.

Pouvez-vous m'aider ?

En vous en remerciant par avance.

Bonjour,

Si tu met le nom "en dur" c'est évident que ce serra celui-là qui serra joint.

Essaye avec

           .Attachments.Add ThisWorkbook

Note que toutes les procédures (macros) seront inclues dans le classeur ?

Si ça va pas tu dis.

A+

Bonjour et merci de votre réponse

J'ai fini par trouver la solution :

Attachments.Add ActiveWorkbook.Fullname 

Cela fonctionne parfaitement.

Si ça peut aider quelqu'un....

Merci.