Macro convertir en Pdf et envoi

[corsu2a]

Bonjour
est ce que quelqu'un peut m'aider. J'ai une super macro qui fonctionne a merveille, dailleur n'hésitez pas à récupérer la source, c'est avec plaisir.

J'aimerais juste modifier un détail dans cette macro mais je n'y arrive pas.
Voici la macro en question

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
Dim OutApp As Object
Dim OutMail As Object
Dim S As Shape
Dim sNomFic As String, sRep As String, WshShell As Object
Dim NomDossier As String
Dim LaDate$, Nom$, Rep$ 'Déclaration des variables


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

' Créer une instance Windows Script pour retrouver le chemin du bureau
Set WshShell = CreateObject("WScript.Shell")
sRep = WshShell.SpecialFolders("Desktop")
Set WshShell = Nothing
' Définit le nom du fichier à enregistrer
sNomFic = "FDG RC CI Vico.pdf"
LaDate = Format(Now, "dd_mm_yyyy_") & Format(Time, "hh_mm_") 'formatage de la date et heure
' 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 = "xxxxxxxx@xxxxxx.fr;xxxxxx@xxxxx.fr"
.Cc = ""
.Attachments.Add (sRep & "\" & sNomFic)
.Subject = "FDG RC CI Vico"
.display
End With

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

j'aimerais tout simplement modifier le titre de la pièce jointe en rajoutant la date afin de l'enregistrer directement dans un dossier et elle se classerait seule par le fait.

sNomFic = "FDG RC CI Vico.pdf" et y rajouter la date

Merci infiniment

 

[Lone-wolf]

Bonjour coursu2a

@corsu2a : tu veux alouté la date? Ceci te donnera une piste

LaDate = Format(Now, "dd_mm_yyyy_") & Format(Time, "hh_mm_") 'formatage de la date et heure.

Tu vois ce qui te reste à faire.

 

[corsu2a]

Bonjour Lone Wolf

je connais cette ligne qui appartient à ma macro EnrgistrePDF mais je ne sais pas comment le rajouter dans

Set OutApp = CreateObject("outlook.application")
Set OutMail = OutApp.CreateItem(0)
With OutMail
.To = "xxxxxxxx@xxxxxx.fr;xxxxxx@xxxxx.fr"
.Cc = ""
.Attachments.Add (sRep & "\" & sNomFic)
.Subject = "FDG RC CI Vico"
.display
End With

Merci quand même

 

[corsu2a]

Bonjour coursu2a

@corsu2a : tu veux alouté la date? Ceci te donnera une piste

LaDate = Format(Now, "dd_mm_yyyy_") & Format(Time, "hh_mm_") 'formatage de la date et heure.

Tu vois ce qui te reste à faire.

Idealement j'aimerais rajouter l'envoi à la suite de cette macro

Sub Enreg_Pdf()
Dim NomDossier As String
Dim CheminDossier As String
Dim LaDate$, Nom$, Rep$ 'Déclaration des variables
On Error GoTo 1

'Nom de dossier
NomDossier = Application.InputBox("Saisissez le mois en cours :", "xxxxxxxxxxxxxxx")
CheminDossier = "C:\Users\..........\Documents\Perso\...........\.............\............\..........\.......\....\.........\" & NomDossier & "\"
LaDate = Format(Now, "dd_mm_yyyy_") & Format(Time, "hh_mm_") 'formatage de la date et heure
Nom = "XXXXXXXXXXXXX" 'Nom de l'onglet à enregistrer
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
CheminDossier & Nom & "_" & LaDate & ".pdf", Quality:= _
xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, _
From:=1, To:=1, OpenAfterPublish:=False 'enregistrement du fichier en PDF
1

End Sub

Merci encore

 

[corsu2a]

Bonjour à Tous

je vous remercie pour votre aide j'ai trouve ce dont j'avais besoin sur un autre forum... merci quand même....

@Saluta