Private Sub CommandButton1_Click()
Dim n As Byte, Wb As Workbook
Application.ScreenUpdating = False
n = Application.SheetsInNewWorkbook
Application.SheetsInNewWorkbook = 1
Set Wb = Workbooks.Add 'nouveau document
Me.Copy Before:=Wb.Sheets(1)
Application.DisplayAlerts = False
Wb.Sheets(2).Delete
Application.SheetsInNewWorkbook = n
Wb.Names.Add "fichier", ThisWorkbook.Path & "\" & ThisWorkbook.Name 'mémorisation
Application.Run Wb.Name & "!" & Wb.Sheets(1).CodeName & ".Lance"
ThisWorkbook.Close False 'fermeture sans enegistrement
End Sub
Sub Lance()
Application.OnTime Now, Me.CodeName & ".Remplace"
End Sub
Sub Remplace()
Dim fich$, test As Boolean, FileFormatNum As Byte
On Error Resume Next
fich = [fichier]
ThisWorkbook.Names("fichier").Delete
Kill fich 'suppression du fichier d'origine
'---enregistrement toujours en .xls---
test = Val(Application.Version) < 12
FileFormatNum = IIf(test, xlWorkbookNormal, 56)
Application.DisplayAlerts = False
ThisWorkbook.SaveAs Replace(fich, ".xlsm", ".xls"), FileFormatNum
End Sub