XL 2016 Boucler sur toutes les feuilles de tous mes fichiers de façon dynamique

[melouze]

Bonjour à tous,

J'essaie de boucler sur les fichiers d'un répertoire, puis pour chaque fichier je dois boucler sur chaque feuille pour activer ou désactiver des protections.

Sub Bouton1_Cliquer()
Dim w As Worksheet
Dim Chemin As String
Dim Fichier As String
Chemin = "D:\Users\Rémi\Desktop\MPG\"
Fichier = Dir(Chemin & "Test*.xlsx", vbNormal)
Do While Fichier <> ""
    MsgBox Chemin & Fichier
    For Each w In Workbooks(Fichier).Sheets
    w.Protect Password:="********", AllowFiltering:=True
    Next
Fichier = Dir
Loop
End Sub

Le parcours des différents fichier fonctionne bien.

Mais cette ligne pose problème, avec une erreur d'éxécution 9, l'indice n'appartient pas à la selection :

For Each w In Workbooks(Fichier).Sheets

En plus la première itération fonctionne bien, mon premier fichier à bien toutes ses feuilles verrouillées...

L'erreur apparaît lors de la 2ème itération.

Si j'enlève la partie qui traite les feuilles, et que je laisse mon "MsgBox Chemin & Fichier", j'ai bien l'ensemble de mes fichiers qui s'affiche un par un.

Si je mets X fois en dur l'instruction "For Each w In Workbooks("Test_X.xlsx").Sheets", cela fonctionne.

Est-ce que quelqu'un à une idée de ce que je peux faire ?

Je vous remercie par avance et vous souhaite une bonne journée.

Rémi

 

[Staple1600]

Bonjour le fil, le forum

Dans ta boucle, tu n'ouvres jamais tes classeurs.
A mon avis, je dirai que cela est un problème manifeste

Retrouvé dans mes archives poussiéreuses
Ici c'est pour déprotéger les feuilles

Spoiler: pour gain de place dans le message

A copier dans un module standard

'=>adapter le nom du chemin et du dossier
Const cStartFolder = "C:\Documents and Settings\Staple\NomDossierAvecClasseursADéprotéger" 
Const cFileFilter = "*.xlsx"
Const cPassword = "motdepasse " '<= mot de passe à adapter
Sub UnprotectAllWorksheets()
    Dim i As Long, j As Long, arr() As String, wkb As Workbook, wks As Worksheet

    ExtractFolder cStartFolder, arr()

    On Error Resume Next
    j = -1: j = UBound(arr)
    On Error GoTo 0

    For i = 0 To j
        Set wkb = Workbooks.Open(arr(i), False)
        For Each wks In wkb.Worksheets
            wks.Unprotect cPassword
        Next
        wkb.Save
        wkb.Close
    Next
End Sub

Sub ExtractFolder(Folder As String, arr() As String)
    Dim i As Long, objFS As Object, objFolder As Object, obj As Object

    Set objFS = CreateObject("Scripting.FileSystemObject")
    Set objFolder = objFS.GetFolder(Folder)

    For Each obj In objFolder.SubFolders
        ExtractFolder obj.Path, arr()
    Next

    For Each obj In objFolder.Files
        If obj.Name Like cFileFilter Then
            On Error Resume Next
            i = 0: i = UBound(arr) + 1
            On Error GoTo 0
            ReDim Preserve arr(i)
            arr(i) = objFolder.Path & Application.PathSeparator & obj.Name
        End If
    Next
End Sub

 

[melouze]

C'est parfait, je n'avais pas compris qu'il était obligatoire d'ouvrir un fichier pour pouvoir lui apporter des modifications

Merci JM !!