Sub Efface()
Dim rep As String
rep = MsgBox("Voulez vous vraiment éffacer les données", vbYesNo, "ATTENTION")
If rep = vbYes Then
Feuil1.Range("E5:G21").ClearContents
Else
Exit Sub
End If
End Sub
Sub Enregistrement()
'Utilisation d'Outlook sans référence
Dim olApp As Object
Dim olMail
Dim chemin As String, nom As String, fichier As String
chemin = "C:\Users\" & Environ("Username") & "\Desktop\"
nom = Feuil1.Range("f5") & " - " & Date
ActiveSheet.Copy
ActiveSheet.DrawingObjects.Delete
ActiveSheet.SaveAs Filename:=chemin & nom & ".xlsm", _
FileFormat:=xlOpenXMLWorkbookMacroEnabled, CreateBackup:=False
ActiveWorkbook.Close True
Set olApp = CreateObject("Outlook.Application")
Set olMail = olApp.CreateItem(0)
fichier = chemin & nom & ".xlsm"
With olMail
.To = "toto.amoto@gmail.com" 'envoyer à:
.Subject = "Tableau récapitulatif" 'sujet
'.BCC = "Tout le monde" 'copies cachées
.Body = "Bonjour à tous" 'corps du message
.Attachments.Add fichier 'pièce jointe
.Display 'pour visualiser le message
'.Send 'pour envois direct
End With
Set olMail = Nothing
Set olApp = Nothing
End Sub