Sub Testsave()
Dim Nom As Variant, Retry As Integer
Dim ClasseurVide As String, Titre As String
MsgBox "Le fichier sera archivé dans le répertoire C:\Estimations"
On Error Resume Next
MkDir "C:\Estimations"
Workbooks.Add
Do While Retry < 3
Retry = Retry + 1
Select Case Retry
Case 1:
Titre = "Premier essai"
Case 2:
Titre = "Deuxième essai"
Case 3:
Titre = "Troisième essai"
End Select
Nom = Application.GetSaveAsFilename("C:\Estimations\" & ClasseurVide, _
filefilter:="Classeur Microsoft Excel (*.xls),*.xls", Title:="Archivage nouveau dossier : " & Titre)
If Nom <> False Then
ActiveWorkbook.SaveAs Filename:=Nom, _
FileFormat:=xlNormal, Password:="", WriteResPassword:="", _
ReadOnlyRecommended:=False, CreateBackup:=False
End If
If Err.Number = 0 And Nom <> False Then
MsgBox "Fichier archivé : " & Nom
Exit Do
Else
Err.Clear
If Retry = 3 Then MsgBox "Votre fichier n'a pas été archivé"
End If
Loop
ActiveWorkbook.Close
End Sub