XL 2019 Mot de passe protéger plusieurs classeurs

  • Initiateur de la discussion Initiateur de la discussion Dadi147
  • Date de début Date de début

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 !

Dadi147

XLDnaute Occasionnel
Bonjour. Existe-t-il un moyen de me permettre de sélectionner plusieurs dossiers sur l'appareil et d'y ajouter un mot de passe sans avoir à les ouvrir ? Pour que personne ne puisse utiliser les fichiers sans entrer le mot de passe
 
Dernière édition:
Solution
Re

Test OK ici
Je te laisse faire l'adaptation pour la macro de déprotection
VB:
Sub Traitement_C()
Application.ScreenUpdating = False
ProtectionDossier "B@Z1Nga!"
End Sub
Private Sub ProtectionDossier(Mot2Passe$)
Dim wbk As Workbook, Chemin$
Chemin = ChoixDossier
    Set fs = CreateObject("Scripting.FileSystemObject")
    Set F = fs.GetFolder(Chemin)
    On Error Resume Next
    For Each myfile In F.Files
        Set wbk = Workbooks.Open(myfile)
        Application.DisplayAlerts = False
        wbk.SaveAs Filename:=wbk.FullName, Password:=Mot2Passe
        wbk.Close False
    Next myfile
End Sub
Function ChoixDossier() As String
Dim FldrPicker As FileDialog, Dossier$
Set FldrPicker = Application.FileDialog(msoFileDialogFolderPicker)...
Bonjour,

Tout dépend si l'on parle de ne pas les ouvrir, ou de ne simplement pas les voir s'ouvrir à l'écran.
Parce que pour faire ce genre de choses, il faut forcément instancier le fichier à minima, pour pouvoir lui apporter une quelconque modification. Par contre, si on ne demande pas à la macro d'ouvrir le fichier et qu'on fige le ScreenUpdating, on ne verra rien à l'écran.

Bonne journée,
 
Bonjour,

Tout dépend si l'on parle de ne pas les ouvrir, ou de ne simplement pas les voir s'ouvrir à l'écran.
Parce que pour faire ce genre de choses, il faut forcément instancier le fichier à minima, pour pouvoir lui apporter une quelconque modification. Par contre, si on ne demande pas à la macro d'ouvrir le fichier et qu'on fige le ScreenUpdating, on ne verra rien à l'écran.

Bonne journée,
Bonjour. Je veux juste définir un mot de passe pour tous les classeurs sélectionnés
 

Pièces jointes

  • excel-mot-passe-4.jpeg.jpg
    excel-mot-passe-4.jpeg.jpg
    44.1 KB · Affichages: 15
Bonsoir

Une possibilité issue de mes archives
(test OK sur O365 W/10)
VB:
Sub Traitement()
Application.ScreenUpdating = False
ProtectionDossier "C:\Users\STAPE\TEST", "B@Z1Nga!"
End Sub
Private Sub ProtectionDossier(Chemin$, Mot2Passe$)
Dim wbk As Workbook
    Set fs = CreateObject("Scripting.FileSystemObject")
    Set F = fs.GetFolder(Chemin)
    On Error Resume Next
    For Each myfile In F.Files
        Set wbk = Workbooks.Open(myfile)
        Application.DisplayAlerts = False
        wbk.SaveAs Filename:=wbk.FullName, Password:=Mot2Passe
        wbk.Close False
    Next myfile
End Sub
NB: Faire les adaptations idoines (le chemin et le mot de passe)
 
Dernière édition:
Bonsoir

Une possibilité issue de mes archives
(test OK sur O365 W/10)
VB:
Sub Traitement()
Application.ScreenUpdating = False
ProtectMyFiles "C:\Users\STAPE\TEST", "B@Z1Nga!"
End Sub
Private Sub ProtectionDossier(Chemin$, Mot2Passe$)
Dim wbk As Workbook
    Set fs = CreateObject("Scripting.FileSystemObject")
    Set F = fs.GetFolder(Chemin)
    On Error Resume Next
    For Each myfile In F.Files
        Set wbk = Workbooks.Open(myfile)
        Application.DisplayAlerts = False
        wbk.SaveAs Filename:=wbk.FullName, Password:=Mot2Passe
        wbk.Close False
    Next myfile
End Sub
NB: Faire les adaptations idoines (le chemin et le
Merci pour votre intérêt. J'utilise la version Office 2021 de Windows 10. Il manque peut-être quelque chose. Veuillez expliquer l'emplacement de la modification pour ajouter le chemin et le mot de passe est : 454567. J'ai essayé beaucoup en vain.
 
Bonsoir

Quand je parle de chemin, il s'agit du chemin du dossier où sont les classeurs à traiter
Dans mon exemple, c'était C:\Users\STAPE\TEST

Donc il faut modifier le code pour pointer vers le dossier où sur ton disque dur il y a tes classeurs à protéger.
 
Salut. Merci. J'ai réussi à faire fonctionner ce code correctement. Je suis maintenant en voyage à la recherche d'un code qui me permette d'ouvrir et de supprimer le mot de passe des fichiers de la même manière. A la fin du trajet, vous recevrez un code de protection et un autre code pour le supprimer

 
Re

Il suffit s'implement d'avoir une seconde macro basée sur la première
(test OK sur mon PC)
PS: idem, pensez à changer le chemin du dossier et le mot de passe dans ce code VBA.
VB:
Sub Traitement_B()
Application.ScreenUpdating = False
DeprotectionDossier "C:\Users\STAPLE\TEST", "B@Z1Nga!"
End Sub
Private Sub DeprotectionDossier(Chemin$, Mot2Passe$)
Dim wbk As Workbook
    Set fs = CreateObject("Scripting.FileSystemObject")
    Set F = fs.GetFolder(Chemin)
    On Error Resume Next
    For Each myfile In F.Files
        Set wbk = Workbooks.Open(myfile, Password:=Mot2Passe)
        Application.DisplayAlerts = False
        wbk.SaveAs Filename:=wbk.FullName, Password:=""
        wbk.Close False
    Next myfile
End Sub
 
Re

Il suffit s'implement d'avoir une seconde macro basée sur la première
(test OK sur mon PC)
PS: idem, pensez à changer le chemin du dossier et le mot de passe dans ce code VBA.
VB:
Sub Traitement_B()
Application.ScreenUpdating = False
DeprotectionDossier "C:\Users\STAPLE\TEST", "B@Z1Nga!"
End Sub
Private Sub DeprotectionDossier(Chemin$, Mot2Passe$)
Dim wbk As Workbook
    Set fs = CreateObject("Scripting.FileSystemObject")
    Set F = fs.GetFolder(Chemin)
    On Error Resume Next
    For Each myfile In F.Files
        Set wbk = Workbooks.Open(myfile, Password:=Mot2Passe)
        Application.DisplayAlerts = False
        wbk.SaveAs Filename:=wbk.FullName, Password:=""
        wbk.Close False
    Next myfile
End Sub
Très très gentil .merci et ce sera merveilleux ou nous avons pu sélectionner le dossier via la liste de contrôle. Application.FileDialog(msoFileDialogFolderPicker)
Et ne pas le mettre dans le code pour être dynamique sur plus d’un dossier
 
Re

Test OK ici
Je te laisse faire l'adaptation pour la macro de déprotection
VB:
Sub Traitement_C()
Application.ScreenUpdating = False
ProtectionDossier "B@Z1Nga!"
End Sub
Private Sub ProtectionDossier(Mot2Passe$)
Dim wbk As Workbook, Chemin$
Chemin = ChoixDossier
    Set fs = CreateObject("Scripting.FileSystemObject")
    Set F = fs.GetFolder(Chemin)
    On Error Resume Next
    For Each myfile In F.Files
        Set wbk = Workbooks.Open(myfile)
        Application.DisplayAlerts = False
        wbk.SaveAs Filename:=wbk.FullName, Password:=Mot2Passe
        wbk.Close False
    Next myfile
End Sub
Function ChoixDossier() As String
Dim FldrPicker As FileDialog, Dossier$
Set FldrPicker = Application.FileDialog(msoFileDialogFolderPicker)
With FldrPicker
    .Title = "Choisir le dossier"
    .AllowMultiSelect = False
    If .Show <> -1 Then Exit Function
    Dossier = .SelectedItems(1) & "\"
  End With
ChoixDossier = Dossier
End Function
 
Re

Test OK ici
Je te laisse faire l'adaptation pour la macro de déprotection
VB:
Sub Traitement_C()
Application.ScreenUpdating = False
ProtectionDossier "B@Z1Nga!"
End Sub
Private Sub ProtectionDossier(Mot2Passe$)
Dim wbk As Workbook, Chemin$
Chemin = ChoixDossier
    Set fs = CreateObject("Scripting.FileSystemObject")
    Set F = fs.GetFolder(Chemin)
    On Error Resume Next
    For Each myfile In F.Files
        Set wbk = Workbooks.Open(myfile)
        Application.DisplayAlerts = False
        wbk.SaveAs Filename:=wbk.FullName, Password:=Mot2Passe
        wbk.Close False
    Next myfile
End Sub
Function ChoixDossier() As String
Dim FldrPicker As FileDialog, Dossier$
Set FldrPicker = Application.FileDialog(msoFileDialogFolderPicker)
With FldrPicker
    .Title = "Choisir le dossier"
    .AllowMultiSelect = False
    If .Show <> -1 Then Exit Function
    Dossier = .SelectedItems(1) & "\"
  End With
ChoixDossier = Dossier
End Function
Plutôt bien.... Merci pour le suivi. Vous êtes vraiment génial.....
 
- 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
17
Affichages
469
Réponses
6
Affichages
96
Réponses
2
Affichages
530
Réponses
5
Affichages
807
Compte Supprimé 979
C
Retour