XL 2019 Mot de passe protéger plusieurs classeurs

xUpsilon à dit:

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,

Cliquez pour agrandir...

Dadi147 à dit:

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

Cliquez pour agrandir...

Staple1600 à dit:

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

Cliquez pour agrandir...

Staple1600 à dit:

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

Cliquez pour agrandir...

Staple1600 à dit:

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

Cliquez pour agrandir...