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
With Application
.ScreenUpdating = False
.EnableEvents = False
End With
Set Sourcewb = ActiveWorkbook
'Copier la feuille actuelle comme une nouvelle feuille
ActiceSheet.Copy 'ou la feuille que tu veux
Set Destwb = ActiveWorkbook
'Verification du format Excel
With Destwb
If Val(Application.Version) < 12 Then
'Past 2003
FileExtStr = ".xls": FileFormatNum = -4143
Else
'Post 2007
Select Case Sourcewb.FileFormat
Case 51: FileExtStr = ".xlsx": FileFormatNum = 51
Case 52:
If .HasVBProject Then
FileExtStr = ".xlsm": FileFormatNum = 52
Else
FileExtStr = ".xlsx": FileFormatNum = 51
End If
Case 56: FileExtStr = ".xls": FileFormatNum = 56
Case Else: FileExtStr = ".xlsb": FileFormatNum = 50
End Select
End If
End With
'Enrengistrement, envoi et supression de la partition créée
TempFilePath = Environ$("temp") & "\"
TempFileName = "le nom" & " que tu veux " & Format(Now, "mmmm") 'mois je mets souvent la date ou le mois dans mes mails
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)
With Destwb
.SaveAs TempFilePath & TempFileName & FileExtStr, FileFormat:=FileFormatNum
On Error Resume Next
With OutMail
.To = 'ton destinataire
.CC = 'en copie
.BCC = 'en copie caché
.Subject = 'sujet
.Body = 'corps
.Attachments.Add Destwb.FullName
.Send
End With
On Error GoTo 0
.Close savechanges:=False
End With
'Supression de l'onglet créée
Kill TempFilePath & TempFileName & FileExtStr
Set OutMail = Nothing
Set OutApp = Nothing