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)...
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
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
Bonjour. Je veux juste définir un mot de passe pour tous les classeurs sélectionnésBonjour,
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 Y a-t-il des solutions suggérées?Bonjour. Je veux juste définir un mot de passe pour tous les classeurs sélectionnés
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
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
Une possibilité issue de mes archives
(test OK sur O365 W/10)
NB: Faire les adaptations idoines (le chemin et leVB: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
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)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
Plutôt bien.... Merci pour le suivi. Vous êtes vraiment génial.....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