XL 2019 Mot de passe protéger plusieurs classeurs

[Dadi147]

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

 

[xUpsilon]

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,

 

[Dadi147]

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

 

[Dadi147]

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

Bonjour Y a-t-il des solutions suggérées?

 

[Staple1600]

Bonsoir

Une possibilité issue de mes archives
(test OK sur O365 W/10)

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)

 

[Dadi147]

Bonsoir

Une possibilité issue de mes archives
(test OK sur O365 W/10)

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.

 

[Staple1600]

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.

 

[Dadi147]

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

Password Protecting Multiple Excel Files at Once

If you like this article, visit my website at justin-hampton.com for more tips, tricks and free tools, such as free market pricing tools and contractor conversion calculators.

www.linkedin.com

 

[Staple1600]

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.

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

 

[Dadi147]

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.

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

 

[Staple1600]

Re

Test OK ici
Je te laisse faire l'adaptation pour la macro de déprotection

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

 

[Dadi147]

Re

Test OK ici
Je te laisse faire l'adaptation pour la macro de déprotection

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.....