Option Explicit
Sub sauver()
Application.ScreenUpdating = False
ActiveSheet.Copy
ChDir "C:\Excel"
Application.Dialogs(xlDialogSaveAs).Show Range("B6") & " - " & Day(Date) & "-" & Month(Date) & "-" & Year(Date)
Application.ScreenUpdating = True
PDF
End Sub
Sub PDF()
Application.ScreenUpdating = False
ActiveSheet.Copy
ChDir "C:\PDF"
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
Range("B6").Value & " - " & Day(Date) & "-" & Month(Date) & "-" & Year(Date) & ".pdf", Quality:= _
xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, _
From:=1, To:=1, OpenAfterPublish:=False
Application.ScreenUpdating = True
SendWithAtt
End Sub
Sub SendWithAtt()
' Macro BrunoM45 modifié pour le chemin
' 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)
'La macro va récupérer le PDF par rapport à la date
CurFile = "C:\PDF" & "\" & Range("B6").Value & " - " & Day(Date) & "-" & Month(Date) & "-" & Year(Date) & ".pdf"
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=CurFile, _
Quality:=xlQualityStandard, IncludeDocProperties:=False, IgnorePrintAreas:=False, _
OpenAfterPublish:=False
With olMail
.To = "xxx@gmail.com"
.CC = "name2@domain2.com"
.Subject = "Main courante Flashover"
.Body = "Vous trouverez ci-joint le fichier PDF ..."
.Attachments.Add CurFile
'.Attachments.Add "c:\My Documents\book.doc"
.Display '.Send
End With
MsgBox "Merci de vérifier que le message apparait dans -messages envoyés- dans votre messagerie OUTLOOK."
' Effacer les variables objets
Set olMail = Nothing
Set olApp = Nothing
End Sub