ThisworkBook

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
Dim Chemin As String, MyFile As String
Range("F1:G1").Select
SaveAsUI = False
Cancel = True
With Worksheets(NomFeuille)
Select Case Left(.Range("F10"), 1)
Case "D": Chemin = CheminDossierDevis
Case "F": Chemin = CheminDossierFacture
End Select
If Dir(Chemin, vbDirectory) = "" Then
MsgBox "Le répertoire devis ou facture n'existe pas !" & Chr(10) & "Le document sera enregistré sur le bureau de votre ordinateur", vbInformation, "Répertoire inexistant"
Chemin = "C:\Users\" & Application.UserName & "\Desktop\"
End If
MyFile = Chemin & .Range("F10") & .Range("G10").Text & Chr(160) & "-" & Chr(160) & .Range("A12") & Chr(160) & "(" & .Range("F14") & ")" & ".xlsm"
End With
If Dir(MyFile) <> "" Then
If MsgBox("Un document nommé '" & MyFile & "' existe déjà à cet emplacement." & Chr(10) & Chr(10) & "Voulez-vous la remplacer ?", vbQuestion + vbYesNo + vbDefaultButton2, "Devis ou facture déjà existant") <> vbYes Then
MsgBox "Le document n'a pas été enregistré !", vbInformation, "Opération annulée"
Exit Sub
End If
End If
Application.EnableEvents = False
Application.DisplayAlerts = False
Me.SaveAs MyFile
Application.DisplayAlerts = False
Application.EnableEvents = True
MsgBox "Le document a bien été enregistré !", vbInformation, "Confirmation"
MsgBox "Voulez-vous créer un nouveau devis ou une nouvelle facture ?", vbYesNo + vbQuestion, "Nouveau document"
End Sub

Cliquez pour agrandir...

MsgBox "Voulez-vous créer un nouveau devis ou une nouvelle facture ?", vbYesNo + vbQuestion, "Nouveau document"

Cliquez pour agrandir...