Microsoft 365 "Enregistrer sous" avec mot de passe à l'ouverture

Boostez vos compétences Excel avec notre communauté !

Rejoignez Excel Downloads, le rendez-vous des passionnés où l'entraide fait la force. Apprenez, échangez, progressez – et tout ça gratuitement ! 👉 Inscrivez-vous maintenant !

etpisculrien

XLDnaute Occasionnel
Bonjour à tous

J'aurais besoin de vos lumières car je galère (ça rime)...
Je vous explique :
Je souhaite faire une macro qui permet d'ouvrir la boite de dialogue "Enregistrer sous" pour permettre à l'utilisateur de choisir le dossier mais en plus que :
1-le nom du fichier soit déjà inscrit et non modifiable dans la boite de dialogue "Enregistrer sous"
2-le fichier soit enregistré avec un mot de passe prédéfini qui sera demandé à l'ouverture

Est ce que ça vous parait possible?

Merci par avance pour votre aide
 
Solution
Bonjour Etpisculrien, Cp4,
Si le nom du fichier est figé, on peut se passer de la fenêtre "Enregistrer sous"
Un essai en PJ où nom du fichier et mot de passe sont "en dur". Le fichier est enregistré dans le dossier courant. Avec :
VB:
Sub SauveAvecPassword()
    Dim Chemin$, Nom$, MotDePasse$
    NomFichier = "Etpisculrien.xlsm"    ' A modifier
    MotDePasse = "1234"                 ' A modifier
    Chemin = ThisWorkbook.Path & "\"    ' A modifier si différent du dossier courant, doit se treminer par "\"
    ActiveWorkbook.SaveAs Filename:=Chemin & NomFichier, Password:=MotDePasse
End Sub
Bonjour Etpisculrien, Cp4,
Si le nom du fichier est figé, on peut se passer de la fenêtre "Enregistrer sous"
Un essai en PJ où nom du fichier et mot de passe sont "en dur". Le fichier est enregistré dans le dossier courant. Avec :
VB:
Sub SauveAvecPassword()
    Dim Chemin$, Nom$, MotDePasse$
    NomFichier = "Etpisculrien.xlsm"    ' A modifier
    MotDePasse = "1234"                 ' A modifier
    Chemin = ThisWorkbook.Path & "\"    ' A modifier si différent du dossier courant, doit se treminer par "\"
    ActiveWorkbook.SaveAs Filename:=Chemin & NomFichier, Password:=MotDePasse
End Sub
 

Pièces jointes

J'ai trouvé une solution pour ça :
'Ouvre la fenetre pour selectionner le dossier
Dim objShell As Object, objFolder As Object, oFolderItem As Object

Set objShell = CreateObject("Shell.Application")
Set objFolder = objShell.BrowseForFolder(&H0&, "Choisir un répertoire", &H1&)

On Error Resume Next
Set oFolderItem = objFolder.Items.Item
Chemin = oFolderItem.Path & "\"

Merci à tous pour votre aide
 
- Navigue sans publicité
- Accède à Cléa, notre assistante IA experte Excel... et pas que...
- Profite de fonctionnalités exclusives
Ton soutien permet à Excel Downloads de rester 100% gratuit et de continuer à rassembler les passionnés d'Excel.
Je deviens Supporter XLD

Discussions similaires

Réponses
5
Affichages
762
Compte Supprimé 979
C
Réponses
10
Affichages
801
Réponses
6
Affichages
1 K
Retour