Toutes feuilles d’un classeur sont protégées avec la première macro en leur affectant un mot de passe donné.
La seconde macro déprotège toutes les feuilles d’un classeur précédemment protégées par un mot de passe donné.
Les mots de passe peuvent être modifiés.
Macro de protection des feuilles d'un classeur
Sub ProtegeFeuilles()
'------------------------------------------------------------------------------------------------
'Procédure de protection des feuilles d'un classeur avec le mot de passe générique cPWD
'-l'utilisateur doit choisir le classeur à protéger
'-Le classeur est fermé a l'issue du traitement
'Auteur : Excellons.org
'Date : juin 2019
'------------------------------------------------------------------------------------------------
Const cPWD = "0987654" 'Password à adapter
Const cFilter = "Classeur EXCEL(*.xls*), *.xls*"
Dim oWB As Workbook
Dim oSheet As Worksheet
Dim sWBName As Variant
Dim sExtension As String
Dim sDecoupe() As String
'On demande à l'utilisateur d'indiquer le nom du classeur à protéger
sWBName = Application.GetOpenFilename(cFilter, 1, "Choisissez le classeur à protéger", , False)
'On s'assure que l'utilisateur n'a pas quitté la boite de dialogue sans indiquer de fichier. Sinon on met fin à l'opération.
If sWBName = False Then
MsgBox "Aucun classeur indiqué !" & vbCrLf & vbCrLf & "Opération sans objet.", vbCritical, "FIN D'OPERATION"
Exit Sub
End If
'On s'assure que l'utilisateur a indiqué un classeur EXCEL
sDecoupe() = Split(sWBName, ".") 'On découpe le nom en 2 pour récupérer son extension
'On s'assure que le fichier choisi possède une extension de classeur EXCEL. Sinon on met fin à l'opération.
If Left(sDecoupe(1), 3) <> "xls" Then
MsgBox "Le fichier indiqué ne semble pas être un classeur EXCEL !" & vbCrLf & vbCrLf & "Opération impossible.", vbCritical, "FIN D'OPERATION"
Exit Sub
End If
'On active la séquence de gestion d'erreurs
On Error GoTo Gestion_Err
'On affecte l'objet local classeur
Set oWB = Application.Workbooks.Open(sWBName)
'On boucle sur toutes les feuilles du classeur
For Each oSheet In oWB.Worksheets
'On protège la feuille avec le mot de passe
oSheet.Protect cPWD
Next
'Séquence de fin de traitement
oWB.Close True 'On ferme le classeur protégé
MsgBox "Les feuilles du classeur '" & sWBName & "' sont protégées avec le mot de passe générique.", vbExclamation, "FIN D'OPERATION"
On Error GoTo 0 'On annule le branchement vers de gestion d'erreur
'On fait le ménage
Set oSheet = Nothing
Set oWB = Nothing
Exit Sub
'Séquence de traitement des erreurs
Gestion_Err:
Select Case Err
Case Else
MsgBox "L'opération de protection du classeur '" & sWBName & "' a rencontré l'erreur suivante :" & vbCrLf _
& Err & "-" & Err.Description, vbCritical, "IMPOSSIBLE DE PROTEGER LE CLASSEUR"
End Select
oWB.Close False
'On fait le ménage
On Error GoTo 0 'On annule le branchement vers de gestion d'erreur
Set oSheet = Nothing
Set oWB = Nothing
End SubMacro de déprotection des feuilles d'un classeur
Sub DeprotegeFeuilles()
'------------------------------------------------------------------------------------------------
'Procédure de déprotection des feuilles d'un classeur protégé avec le mot de passe générique
'-l'utilisateur doit choisir le classeur à déprotéger
'-Le classeur est fermé a l'issue du traitement
'Auteur : Excellons.org
'Date : juin 2019
'------------------------------------------------------------------------------------------------
Const cPWD = "0987654" 'Password à adapter
Const cFilter = "Classeur EXCEL(*.xls*), *.xls*"
Dim oWB As Workbook
Dim oSheet As Worksheet
Dim sWBName As Variant
Dim sExtension As String
Dim sDecoupe() As String
'On demande à l'utilisateur d'indiquer le nom du classeur à déprotéger
sWBName = Application.GetOpenFilename(cFilter, 1, "Choisissez le classeur à déprotéger", , False)
'On s'assure que l'utilisateur n'a pas quitté la boite de dialogue sans indiquer de fichier. Sinon on met fin à l'opération.
If sWBName = False Then
MsgBox "Aucun classeur indiqué !" & vbCrLf & vbCrLf & "Opération sans objet.", vbCritical, "FIN D'OPERATION"
Exit Sub
End If
'On s'assure que l'utilisateur a indiqué un classeur EXCEL
sDecoupe() = Split(sWBName, ".") 'On découpe le nom en 2 pour récupérer son extension
'On s'assure que le fichier choisi possède une extension de classeur EXCEL. Sinon on met fin à l'opération.
If Left(sDecoupe(1), 3) <> "xls" Then
MsgBox "Le fichier indiqué ne semble pas être un classeur EXCEL !" & vbCrLf & vbCrLf & "Opération impossible.", vbCritical, "FIN D'OPERATION"
Exit Sub
End If
'On active la séquence de gestion d'erreurs
On Error GoTo Gestion_Err
'On affecte l'objet local classeur
Set oWB = Application.Workbooks.Open(sWBName)
'On boucle sur toutes les feuilles du classeur
For Each oSheet In oWB.Worksheets
'On déprotège la feuille
oSheet.Unprotect cPWD
Next
'Séquence de fin de traitement
oWB.Close True 'On ferme le classeur
MsgBox "Les feuilles du classeur '" & sWBName & "' sont déprotégées du mot de passe générique.", vbExclamation, "FIN D'OPERATION"
On Error GoTo 0 'On annule le branchement vers de gestion d'erreur
'On fait le ménage
Set oSheet = Nothing
Set oWB = Nothing
Exit Sub
'Séquence de traitement des erreurs
Gestion_Err:
Select Case Err
Case Else
MsgBox "L'opération de déprotection du classeur '" & sWBName & "' a rencontré l'erreur suivante :" & vbCrLf _
& Err & "-" & Err.Description, vbCritical, "IMPOSSIBLE DE DEPROTEGER LE CLASSEUR"
End Select
'On fait le ménage
On Error GoTo 0 'On annule le branchement vers de gestion d'erreur
Set oSheet = Nothing
Set oWB = Nothing
End Sub