XL 2010 SaveAs Filename

Option Explicit

Sub Nouv_Achats()
Dim derlig&, i&, AncWk As Workbook
Dim chemin$, temp$, NouvNom$, t As Date

    chemin = ThisWorkbook.Path & "\Fichiers\"

    With Sheets(1)
        derlig = .Cells(Rows.Count, "A").End(xlUp).Row

        Set AncWk = Workbooks("Achats.xlsm")

        For i = 2 To derlig
            temp = Format(.Cells(i , "A"), "dd_mm_yyyy à h""h ""mm")

            NouvNom = "achat le " & temp

            AncWk.SaveAs Filename:=chemin & NouvNom & ".xls", FileFormat:=xlExcel8
            t = Timer + 1: Do Until Timer > t: DoEvents: Loop
        Next i
    End With

    Application.DisplayAlerts = False
    ThisWorkbook.Save
    Application.Quit
End Sub

Private Sub CommandButton1_Click()
Dim fn$
Application.ScreenUpdating = False
Application.DisplayAlerts = False 'si le fichier existe déjà
With Workbooks.Add(xlWBATWorksheet).Sheets(1)
    ActiveWindow.DisplayGridlines = False 'pas de quadrillage
    .Name = Me.Name
    Me.Cells.Copy .[A1]
    .[A1].CurrentRegion.Borders.Weight = xlThin
    .Columns.AutoFit 'ajustement largeur
    fn = ThisWorkbook.FullName
    fn = Left(fn, InStrRev(fn, ".") - 1) 'sans l'extension
   .SaveAs fn & " achat le " & Format(Now, "dd-mm-yyyy \à hh\h mm\m\i\n"), 56  'fichier .xls
    .Parent.Close
End With
End Sub

Private Sub CommandButton1_Click()
Dim fn$
Application.ScreenUpdating = False
Application.DisplayAlerts = False 'si le fichier existe déjà
Me.Copy
With ActiveSheet
    .OLEObjects.Delete 'supprime le bouton
    .[A1].CurrentRegion.Borders.Weight = xlThin
    .Columns.AutoFit 'ajustement largeur
    fn = ThisWorkbook.FullName
    fn = Left(fn, InStrRev(fn, ".") - 1) 'sans l'extension
    .SaveAs fn & " achat le " & Format(Now, "dd-mm-yyyy \à hh\h mm\m\i\n"), 51  'fichier .xlsx
    .Parent.Close
End With
End Sub