VBA - enlever la protection de tous les classeurs d'un dossier

Le 04/04/2021 à 17:18

Bonjour à tous !

Je reviens chercher un peu aide.

J'essaie de construire une macro qui permet, pour chaque classeur d'un dossier, d'enlever la protection du classeur et d'afficher toutes les feuilles de calcul, sans les ouvrir un à un.
Je débute en VBA du coup je construit à partir de macro éparpillées sur internet.
J'ai construit la boucle mais je suis bloqué au moment d'enlever la protection.

Voici mon code :

Sub TabsDisplay()

Dim dossier As Object
Dim chemin_dossier As String
Dim fichier As Object

'identifier le chemin du dossier
chemin_dossier = "C:\Users\User\Desktop\assemblage données\Fichiers sources\test"

Set Fso = CreateObject("Scripting.FileSystemObject")

'identifier le dossier
Set dossier = Fso.getfolder(chemin_dossier)

'on boucle sur les fichiers du  dossier
For Each fichier In dossier.Files

    ' enlever la protection du classeur
    ActiveWorkbook.Unprotect Password:="asp"
    ' Afficher tous les onglets
    Dim c As Worksheet
    For Each c In Sheets
    c.Visible = True
    Next c
    Next
End Sub

ActiveWorkbook fait que la boucle n'a pas lieu, l'action ne se passe que sur le fichier activé. Mais je ne sais pas quel objet mettre. J'ai essayé fichier mais ce la ne fonctionne pas...

Quelqu'un pourrait-il m'aiguiller ?

Une fois cette étape réussi, je pense qu'il faudra que j'ajoute une action pour enregistrer le document avant le second Next. Mais je verrais ça après

Je me pose également la question, si dans ce sous dossier j'ajoute de nouveaux dossiers, seront-ils intégrés à la boucle ?

Merci pour votre aide et ne manger pas trop de chocolat

Le 05/04/2021 à 00:43

Bonjour,

Vous avez oublié d'ouvrir les fichiers dans votre boucle :

Sub TabsDisplay()

Dim dossier As Object
Dim chemin_dossier As String
Dim fichier As Object
Dim c As Worksheet

'identifier le chemin du dossier
chemin_dossier = "C:\Users\User\Desktop\assemblage données\Fichiers sources\test"
Set Fso = CreateObject("Scripting.FileSystemObject")
Set dossier = Fso.getfolder(chemin_dossier)

application.screenupdating = false
For Each fichier In dossier.Files 'pour chaque fichier
    with workbooks.open(fichier.path) 'avec le fichier en cours, ouvert à l'instant
        .Unprotect Password:="asp" 'deprotection
        For Each ws In .sheets 'pour chacune de ses feuilles
            ws.Visible = True 'devient visible
        Next ws
        '.protect "asp" 'si besoin, reprotège
        .close true 'ferme et sauve le classeur
    end with
Next
application.screenupdating = true

End Sub

Pour l'instant, cette macro ne traite que les fichiers du dossier mais n'agit pas sur les fichiers de ses sous-dossiers...

Un essai récursif :

Sub TabsDisplay()
Dim fso as object, rep As String
rep = "C:\Users\User\Desktop\assemblage données\Fichiers sources\test"
Set Fso = CreateObject("Scripting.FileSystemObject")
Parcourir fso, rep
end sub

Sub Parcourir(fso as object, Repertoire$)
Set dossier = fso.getfolder(Repertoire)
for each fil in dossier.files
    RendreVisible fil.path 'on rend visible chaque fichier du dossier
next fil
for each sfd in dossier.subfolders
    Parcourir fso, sfd.path 'on recommence avec ses sous-dossiers !
next sfd
end sub

Sub RendreVisible(sfilepath$, optional mdp$ = "asp")
application.screenupdating = false
with workbooks.open(sfilepath) 'avec le fichier en cours, ouvert à l'instant
    .Unprotect mdp 'deprotection
    For Each ws In .sheets 'pour chacune de ses feuilles
        ws.Visible = True 'devient visible
    Next ws
    '.protect mdp 'si besoin, reprotège
    .close true 'ferme et sauve le classeur
end with
application.screenupdating = true
End Sub

Cdlt,

Le 05/04/2021 à 12:50

Bonjour @3GB merci pour votre réponse complète j'y vois beaucoup plus clair et ça fonctionne !

Toutefois, je note que la macro ferme également le fichier depuis laquelle elle est lancée. Est-il possible de mettre une exception pour empêcher la fermeture de ce fichier (mais appliquer tout même l'enregistrement) ?

Je vous suis reconnaissant pour votre aide.

Edit :

J'ai approfondi mon projet et en fait, le fichier contenant la macro n'aurait pas de données à traiter. J'ai donc intégré une condition

If fichier.Name <> ThisWorkbook.Name Then

Qui permet de ne pas traiter le fichier d'où est lancé la macro. En faisant du pas à pas détaillé, ça fonctionne bien, le fichier concerné n'est pas traité.

Toutefois, une fois l'ensemble des fichiers bouclé, la macro revient sur celui qui la contient et un message d'erreur apparaît :

image

Je ne comprends pas trop pourquoi il apparaît...

Voici ma macro actualisée :

Sub DisplaySheetsProtecClasseur()

Dim dossier As Object
Dim chemin_dossier As String
Dim fichier As Object
Dim c As Worksheet

'identifier le chemin du dossier
chemin_dossier = ThisWorkbook.Path
Set Fso = CreateObject("Scripting.FileSystemObject")
'identifier le dossier
Set dossier = Fso.getfolder(chemin_dossier)

Application.ScreenUpdating = False 'pour accélérer l'exécution de la macro, empêche la mise à jour de l'écran
For Each fichier In dossier.Files 'pour chaque fichier
    If fichier.Name <> ThisWorkbook.Name Then
        With Workbooks.Open(fichier.Path) 'avec le fichier en cours, ouvert à l'instant
            .Unprotect Password:="asp" 'deprotection
                For Each ws In .Sheets 'pour chacune de ses feuilles
                    ws.Visible = True 'devient visible
                Next ws
            '.protect "asp" 'si besoin, reprotège
            .Close True 'ferme et sauve le classeur
        End With
    End If
Next
Application.ScreenUpdating = True
MsgBox ("Tous les classeurs sont déverrouillés")
End Sub

Quelqu'un a-t-il une idée ?

Le 05/04/2021 à 16:31

Bonjour,

Le message est étrange mais il est normal qu'il y ait un bug si le fichier est déjà ouvert...

Y a-t-il un caractère "spécial" dans le titre de votre fichier ?

Voici un essai en changeant la condition car 2 fichiers peuvent porter le même nom sans pour autant avoir le même chemin :

Sub DisplaySheetsProtecClasseur()

Dim dossier As Object
Dim chemin_dossier As String
Dim fichier As Object
Dim c As Worksheet

'identifier le chemin du dossier
chemin_dossier = ThisWorkbook.Path
Set Fso = CreateObject("Scripting.FileSystemObject")
'identifier le dossier
Set dossier = Fso.getfolder(chemin_dossier)

Application.ScreenUpdating = False 'pour accélérer l'exécution de la macro, empêche la mise à jour de l'écran
For Each fichier In dossier.Files 'pour chaque fichier
    If fichier.path <> ThisWorkbook.fullName Then
        With Workbooks.Open(fichier.Path) 'avec le fichier en cours, ouvert à l'instant
            .Unprotect Password:="asp" 'deprotection
                For Each ws In .Sheets 'pour chacune de ses feuilles
                    ws.Visible = True 'devient visible
                Next ws
            '.protect "asp" 'si besoin, reprotège
            .Close True 'ferme et sauve le classeur
        End With
    End If
Next
Application.ScreenUpdating = True
MsgBox ("Tous les classeurs sont déverrouillés")
End Sub

Aussi, on déprotège après ouverture. Il est possible qu'il faille déprotéger à l'ouverture...

Pour tester, vous pourriez déjà sortir le fichier exécutant du dossier.

Cdlt,

Le 05/04/2021 à 17:15

Il n'y a pas de caractère spécial dans le titre "Macro.xlsm" j'ai enlevé la majuscule mais ça n'a rien changé.

J'ai pris en compte les modifications que vous proposez dans la macro, mais le message apparaît toujours...

Si le fichier avec la macro se trouve dans un autre dossier alors je n'ai pas de message d'erreur (même sans les modifications).

Est-on obligé d'ouvrir les fichiers pour faire ces changements?

Le 05/04/2021 à 18:15

Et en essayant avec cette ligne modifiée :

With Workbooks.Open(fichier.Path, , , , "asp")

Puis, même si d'après ce que vous dites, ça ne semble pas être la cause du problème, avec un filtre pour boucler seulement sur les fichiers excel :

Sub DisplaySheetsProtecClasseur()

Dim dossier As Object
Dim chemin_dossier As String
Dim fichier As Object
Dim c As Worksheet

'identifier le chemin du dossier
chemin_dossier = ThisWorkbook.Path
Set Fso = CreateObject("Scripting.FileSystemObject")
'identifier le dossier
Set dossier = Fso.getfolder(chemin_dossier)

Application.ScreenUpdating = False 'pour accélérer l'exécution de la macro, empêche la mise à jour de l'écran
For Each fichier In dossier.Files 'pour chaque fichier
    If fichier.path <> ThisWorkbook.fullName and fichier.name like "*.xls*" Then
        With Workbooks.Open(fichier.Path) 'avec le fichier en cours, ouvert à l'instant
            .Unprotect Password:="asp" 'deprotection
                For Each ws In .Sheets 'pour chacune de ses feuilles
                    ws.Visible = True 'devient visible
                Next ws
            '.protect "asp" 'si besoin, reprotège
            .Close True 'ferme et sauve le classeur
        End With
    End If
Next
Application.ScreenUpdating = True
MsgBox ("Tous les classeurs sont déverrouillés")
End Sub

Oui, j'ai peur qu'il faille nécessairement ouvrir le classeur pour rendre ses feuilles visibles...

Pourrez-vous ensuite faire un essai avec seulement le fichier exécutant dans le dossier ? Ce sera plus simple pour vous de faire du pas à pas. vous pourrez éventuellement rajouter pour contrôle 2 msgbox :

msgbox thisworkbook.fullname

msgbox fichier.path

Cdlt,

Le 05/04/2021 à 19:43

Merci pour ces éléments. Malheureusement ça ne change rien.

En ayant tout pris en compte et en lançant la macro uniquement avec le fichier contenant la macro dans le dossier, j'ai le même message d'erreur.
Quand la boucle se lance, le If est bien pris en compte et passe directement à "End IF" mais le "Next" fait reprendre la boucle sur le fichier .xlm et entre le "With" pour ce fichier. Le même message d'erreur s'affiche...

Le 05/04/2021 à 19:48

Bonsoir X-ben, 3GB,


Selon ton image du message de ce jour à 12h50

Il semblerait que tu ais un fichier temporaire qui resterait de ton fichier macro utilisé habituellement.

Car les caractères spéciaux au début du nom du fichier sont réservés aux fichiers temporaires.

Soit tes autres fichiers ne sont pas de type xlsm. Alors tu exclues ce type dans ta recherche de fichiers à ouvrir.

Sinon dans ta condition IF tu insères aussi un Like "*Macro.xlsm" pour éviter de le prendre.

Le 05/04/2021 à 20:28

Il semble que j'avais oublié un "s" dans le nom de format.

En mettant cette ligne ça fonctionne

 If fichier.Path <> ThisWorkbook.FullName And fichier.Name Like "*.xlsx" Then

Toutefois j'ai essayé d'ajouter un Like "*Macro.xlsm" ça ne prend en compte que ce fichier du coup.

J'ai essayé

If fichier.Name <> "*Macro.xlsm" Then

Et le message s'affiche tout de même.

(Pas de trace de fichiers temporaires dans le dossier)

Donc problème à moitié résolu étant donné que je n'ai que des xlsx

Le 05/04/2021 à 21:06

Salut X Cellus ,

Je pense que ton intuition est bonne. Il est vrai qu'il peut y avoir plus de fichiers que ceux visibles dans les dossiers.

@ben : As-tu essayé mon code de 18h15 ? J'ai l'impression que non (pour la question du like).

Il est possible de rajouter une condition dans le if au cas où :

If fichier.path <> ThisWorkbook.fullName and fichier.name like "*.xls*" and fichier.attributes <= 33 Then

Ca pourrait permettre d'éviter les fichiers particuliers (enfin, c'est une "conclusion" que j'ai tirée suite à quelques essais mais ce n'est probablement pas une vérité !).

Cdlt,

Le 05/04/2021 à 21:27

@3GB, j'avais bien essayé le code de 18h35, sans succès.

Mais avec celle nouvelle précision cela fonctionne parfaitement ! Merci pour votre aide à tous les deux !

Je suis tout de même curieux de comprendre à quoi correspond ce ".attributes <= 33"

Le 05/04/2021 à 22:47

Alors, comme j'ai dit sur mon dernier message, il s'agit d'une découverte empirique sans que je l'ai parfaitement comprise.

Ce lien sera probablement plus clair que moi : https://docs.microsoft.com/fr-fr/office/vba/language/reference/user-interface-help/attributes-proper...

Le principe, c'est que chaque attribut est valorisé par un nombre. Quand un fichier a plusieurs attributs, la propriété renvoie la somme de ses attributs.

Or, de mémoire, je ne sais pas pourquoi, il semble que tous les fichiers "normaux" aient l'attribut archive, valant par conséquent au minimum 32. Donc, <=33 C'est pour conserver les fichiers normaux ou en lecture seule, pas les autres. Mais je me trompe peut-être.

Mais si quelqu'un pouvait donner plus de précisions, il apporterait sûrement une meilleure réponse que celle-ci.

Cdlt,

Le 05/04/2021 à 23:22

D'accord j'y vois beaucoup plus clair, merci encore pour ton aide et ta pédagogie !

Bonne soirée

Rechercher des sujets similaires à "vba enlever protection tous classeurs dossier"