Sub EnregistrerSous()
Dim NomFichier$, Dossier$, v$, x$, w$, y$, z$
Dossier = ChoixDossier
If Dossier = "" Then Exit Sub
Application.ScreenUpdating = False
With Worksheets("Devis")
w = .Range("D3")
v = "-" & .Range("A4")
x = "-" & .Range("D4")
y = "-" & Format(Date, "dd mm yyyy")
z = "-" & Format(Time, "hhmmss")
.Copy
End With
NomFichier = w & v & x & y & z & ".xlsm"
With ActiveWorkbook
.SaveAs Dossier & "\" & NomFichier
.Close
End With
End Sub
'http://msdn.microsoft.com/en-us/library/windows/desktop/bb774065%28v=vs.85%29.aspx
Function ChoixDossier() As String
Dim objShell
Dim objFolder
Set objShell = CreateObject("shell.application")
Set objFolder = objShell.BrowseForFolder(0, "Choisissez le dossier de sauvegarde", 0, 5)
If (Not objFolder Is Nothing) Then
ChoixDossier = objFolder.Self.Path
End If
Set objFolder = Nothing
Set objShell = Nothing
End Function