Comment interdire de renommer un ficher excel ?

Sub Essai()
Dim VPath As String, NomFic As String
VPath = ChoixDossier(ThisWorkbook.Path)
NomFic = "Toto"
ThisWorkbook.SaveAs VPath & "\" & NomFic
End Sub
 
Function ChoixDossier(Racine)
Dim objShell, objFolder, Chemin, SecuriteSlash, Msg$
Msg = "Choisissez votre dossier de sauvegarde :"
' Création de l'objet
Set objShell = CreateObject("Shell.Application")
Set objFolder = objShell.BrowseForFolder(&H0&, Msg, &H1&, Racine)
On Error Resume Next
Chemin = objFolder.ParentFolder.ParseName(objFolder.Title).Path & ""
If objFolder.Title = "Bureau" Then
Chemin = "C:\Windows\Bureau"
End If
If objFolder.Title = "" Then
Chemin = ""
End If
' Vérifier du slash
SecuriteSlash = InStr(objFolder.Title, ":")
If SecuriteSlash > 0 Then
Chemin = Mid(objFolder.Title, SecuriteSlash - 1, 2) & ""
End If
ChoixDossier = Chemin
End Function