Commande excel avec Workbook_BeforeSave

Regardes ici une discussion similaire avec un code donné

https://forums.commentcamarche.net/forum/affich-28440744-interdire-d-enregistrer-sous-un-nom-de-fichier

Cdlmnt

En fait il faut que la personne puisse l'enregistrer sous un autre endroit.

J'ai trouvé ceci qui pourrait m'aider.

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)

Dim Reponse As Variant

Reponse = Application.InputBox("Entrez votre identifiant", "Autorisation", , , , , , 2)

If VarType(Reponse) = vbBoolean Then
Reponse = MsgBox("Fichier non sauvegardé, Réessayer ?", vbYesNo)
If Reponse = vbYes Then ' L'utilisateur a choisi Oui.
Reponse = Application.InputBox("Entrez votre identifiant", "Autorisation", , , , , , 2)
If VarType(Reponse) = vbBoolean Then
MsgBox "Modifications perdues...", vbOKOnly
Cancel = True
ElseIf StrComp(Reponse, "MDP") <> 0 Then
Cancel = True
End If
Else ' L'utilisateur a choisi Non.
Cancel = True
End If
ElseIf StrComp(Reponse, "MDP") <> 0 Then
Reponse = MsgBox("Mot de passe érroné, Réessayer ?", vbYesNo)
If Reponse = vbYes Then ' L'utilisateur a choisi Oui.
Reponse = Application.InputBox("Entrez votre identifiant", "Autorisation", , , , , , 2)
If VarType(Reponse) = vbBoolean Then
MsgBox "Modifications perdues...", vbOKOnly
Cancel = True
ElseIf StrComp(Reponse, "MDP") <> 0 Then
Cancel = True
End If
Else ' L'utilisateur a choisi Non.
Cancel = True
End If
End If
End Sub

Mon seul problème est qu'il le lance à chaque fois j'essaie d'enregistrer je voudrais il me demande seulement si j'essaie d'enregistrer sous : "P:\Secrétariat et administration\Classeur1.xls"

Merci de votre temps !

Bonsoir

Pas besoin de passer par du VBA l'option est prévue par Excel

Faire Enregistrer sous
Donner un nouveau nom au fichier
Cliquez en bas sur Outils puis Options générales
Entrer le mot de passe

Cdlmnt