1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30
| Sub sauvegarde()
'enregistre sous au format xls, dans "mes documents"
'gestion de l'erreur si le même fichier est ouvert
Dim StrDate As String, StrFichier As String
On Error GoTo GestErreur
Range("B2").Select
StrDate = Format(ActiveCell.Value, "yyyy-mm-dd")
Range("C2").Select
StrFichier = "listing_" & ActiveCell.Value & "_" + StrDate & ".xls"
With Application.FileSearch
.NewSearch
.LookIn = Environ("temp")
.SearchSubFolders = True
.Filename = StrFichier
.MatchTextExactly = True
.FileType = msoFileTypeAllFiles
.Execute
If .FoundFiles.Count > 0 Then Kill Environ("temp") & "\" & StrFichier
End With
ActiveWorkbook.SaveAs Filename:= _
Environ("temp") & "\" & StrFichier, _
FileFormat:=xlExcel9795, Password:="", WriteResPassword:="", ReadOnlyRecommended:= _
False, CreateBackup:=False, AccessMode:=xlExclusive, ConflictResolution:=xlLocalSessionChanges
Exit Sub
GestErreur:
MsgBox ("message erreur")
End Sub |
Partager