Sub SAVEFORMUL()
'
' SAVEFORMUL Macro
' Macro enregistrée le 29/09/2007 par ANDRE
'
Dim Nomfichier As String, Entree As String
Dim f As Worksheet 'déclare la variable f
Dim fich As Workbook
Dim lerep
lerep = ActiveWorkbook.Path
Dim racine
racine = "C:\Users\Fred\Desktop\"
Début:
Entree = InputBox("Please select number of formulae (4 numbers)")
If Len(Entree) = 4 And IsNumeric(Entree) Then
Entree = InputBox("Please select a date (DDMMYYYY")
If Len(Entree) = 8 And IsNumeric(Entree) Then
Nomfichier = "TFC" & Left(Entree, 4) '& "make on " & Right(Entree, 8)
'' With Application.FileSearch
'' .NewSearch
'' .LookIn = lerep
'' .Filename = Nomfichier & ".xls"
'' .MatchTextExactly = True
'' .Execute
'' FileExists = .FoundFiles.Count = 1
'' If FileExists Then
'' MsgBox "This formulae already exist ! Please select an other name": GoTo Début
'' End If
'' End With
ActiveSheet.Copy
For Each obj In ActiveSheet.Shapes
obj.Delete
Next
For Each Nom In ActiveWorkbook.Names
Nom.Delete
Next
ActiveWorkbook.SaveAs Filename:=racine & Nomfichier & ".xls" 'm", FileFormat _
:=xlOpenXMLWorkbookMacroEnabled, CreateBackup:=False
ActiveSheet.Name = Nomfichier
Msg = "Your fourmulae has been saved in the format TFCxxxx/date"
Title = "SAVE FORMULAE"
Style = vbOKOnly + vbInformation
Reponse = MsgBox(Msg, Style, Title)
ActiveWorkbook.Close (False)
Else
MsgBox "BAD FORMAT, Please try again": GoTo Début
MsgBox "BAD FORMAT, Please try again": GoTo Début
End If
End If
End Sub