Nom de fichier créé à partir d'une cellule pour exporter en PDF
Bonjour,
J'utilise le code plus bas pour exporter mon fichier en PDF et l'envoyer par courriel automatiquement.
Présentement le fichier s'exporte avec le nom de l'onglet.pdf.
Mais je voudrais nom de l'onglet + date d'une celule + .pdf
Comment puis-je ajuster le code plus bas pour y arriver ?
Merci de votre aide!
Sub CommandButton2_Click()
'Fonctionne sous excel 2000-2013
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
'----------------------------------------------------------------------------
TempFilePath = Environ$("temp") & "\"
TempFileName = ActiveSheet.Name
Set OutApp = CreateObject("outlook.application")
Set OutMail = OutApp.CreateItem(0)
With destwb
.ExportAsFixedFormat Type:=xlTypePDF, Filename:=TempFilePath & TempFileName & ".pdf", Quality:=xlQualityStandard, _
IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False ' sauvegarde du fichier au format pdf
On Error Resume Next
With OutMail
.To = "test"
.CC = "test"
.bcc = ""
.Subject = "F&B Daily Financial Report"
.Attachments.Add TempFilePath & TempFileName & ".pdf"
.Body = "Bonjour," & vbNewLine & vbNewLine & _
"Please find yesterday report in attachment." & vbNewLine & vbNewLine & _
"Bonne journée,"
.display 'ou alors utiliser
'.Send 'pour envoi
End With
On Error GoTo 0
.Close savechanges:=False
End With
'Effacer le fichier envoyé
Kill TempFilePath & TempFileName & ".pdf"
Set OutMail = Nothing
Set OutApp = Nothing
With Application
.ScreenUpdating = True
.EnableEvents = True
End With
End Sub
Bonjour,
Sans fichier test, difficile de taper dans le mille dès le premier coup...
Sub CommandButton2_Click()
'Fonctionne sous excel 2000-2013
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 datedu_jouR As String
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
'----------------------------------------------------------------------------
' "datedu_jouR" est la date que l'on va manipuler pour l'insérer dans le nom du fichier à sauvegarder : je considère que la date est en "Y10" au format 19/06/2021
datedu_jouR = Format(Range("Y10"), "yyyy.mm.dd")
TempFilePath = Environ$("temp") & "\"
TempFileName = ActiveSheet.Name & "-" & datedu_jouR
Set OutApp = CreateObject("outlook.application")
Set OutMail = OutApp.CreateItem(0)
With destwb
.ExportAsFixedFormat Type:=xlTypePDF, Filename:=TempFilePath & TempFileName & ".pdf", Quality:=xlQualityStandard, _
IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False ' sauvegarde du fichier au format pdf
On Error Resume Next
With OutMail
.To = "test"
.CC = "test"
.bcc = ""
.Subject = "F&B Daily Financial Report"
.Attachments.Add TempFilePath & TempFileName & ".pdf"
.Body = "Bonjour," & vbNewLine & vbNewLine & _
"Please find yesterday report in attachment." & vbNewLine & vbNewLine & _
"Bonne journée,"
.display 'ou alors utiliser
'.Send 'pour envoi
End With
On Error GoTo 0
.Close savechanges:=False
End With
'Effacer le fichier envoyé
Kill TempFilePath & TempFileName & ".pdf"
Set OutMail = Nothing
Set OutApp = Nothing
With Application
.ScreenUpdating = True
.EnableEvents = True
End With
End SubJe n'ai pas testé alors à toi d'ajuster avec la cellule où se trouve la date (moi je l'ai considérée en "Y10")..
Voilà,
Joe
Fantastique exactement ce que je cherchais!
J'ai ajusté un peu pour bien répondre a mon besoin.
Merci :-)