Boucle sur toutes les feuilles de tous les classeurs de plusieurs dossiers

Résolu
Signaler
-
 ludoja -
Re bonjour à tous,

Nouveau problème... auquel je ne trouve pas de solutions
Je souhaite faire une boucle permettant de copier dans toutes les feuilles de tous les classeurs de tous les dossiers les valeurs entrées dans différentes textbox.
Voici ce que j'ai essayé mais j'ai une erreur d'incompatibilité de type pour la deuxième boucle "for each".
Comment donc déclarer la variable f1 (car je pense que le pb vient de cette variable) pour qu'elle soit reconnu par la 1ère boucle for each et la 2ème?

voici le code et comment sont faites les déclarations:
Dim Fso As Object
Dim Racine As String
Dim f1 As Object
Dim f2 As Workbook
Dim sh As Worksheet
Dim prod As Integer
prod = 26


While Sheets("Complet").Cells(prod, 1).Value <> ""
    prod = prod + 1
Wend

Set Fso = CreateObject("Scripting.FileSystemObject")
Racine = "C:\Users\Loic\Desktop\SORTIES1\DATA"

For Each f1 In Fso.GetFolder(Racine).SubFolders
'Ligne du dessous= le problème
    For Each f2 In Fso.GetFolder(f1).Files   
            For Each sh In f2.Worksheets
                    sh.Cells(prod, 1).Value = ComboBox_lot.Value
                    sh.Cells(prod, 4).Value = TextBox2.Value
                    sh.Cells(prod, 2).Value = TextBox4.Value
                    sh.Cells(prod, 3).Value = TextBox5.Value
                    sh.Cells(prod, 37).Value = TextBox6.Value
            Next sh
    Next f2
Next f1

9 réponses

Messages postés
172
Date d'inscription
jeudi 8 décembre 2011
Statut
Membre
Dernière intervention
21 juillet 2013
2
.Activate comme .Select allonge la durée du processus ...

Afin d'accélérer ta procédure, mieux vaut supprimer la ligne sh.Activate
puis modifier le code comme ceci :
           [...]
                            With sh.Range("A" & prod - 15 & ":" & "AL" & prod - 15)
                                With .Borders
                                       .LineStyle = xlContinuous
                                      .ColorIndex = 0
                                    .TintAndShade = 0
                                          .Weight = xlThin
                                End With
                                
                                .Borders(xlDiagonalDown).LineStyle = xlNone
                                  .Borders(xlDiagonalUp).LineStyle = xlNone
                            End With
                    Next sh
           [...]

(Insomnie quand tu nous tiens ...)

___________________________________________________________________________________________________________________
Comme la vitesse de la lumière est supérieure à celle du son, certains ont l'air brillant avant d'avoir l'air con !
Messages postés
14008
Date d'inscription
samedi 29 décembre 2001
Statut
Modérateur
Dernière intervention
28 août 2015
81
Salut

Ne confonds pas fichier et classeur; ce sont deux objets différents.
Dim f2 As Workbook
Set f2 = Workbooks.Open("le nom du fichier")
Et ensuite, tu pourras énumérer les feuilles de ce classeur.
Il faudra bien sûr penser à le refermer après usage.

Vala
Jack, MVP VB
NB : Je ne répondrai pas aux messages privés

Le savoir est la seule matière qui s'accroit quand on la partage (Socrate)
Salut Jack,

Merci pour ta réponse.
J'ai bien saisi maintenant la différence entre classeur et fichier.
Mon problème maintenant est comment réaliser une boucle sur tous les fichiers sans exception d'un dossier sans avoir à les appeler par leur nom (workbooks.open ("nom fichier")).

J'ai essayé un truc du genre (avec GetFile):

For Each f1 In Fso.GetFolder(Racine).SubFolders
        racine1 = Racine + f1
        MsgBox (racine1)
    For Each f2 In Fso.GetFile(racine1).Files
            For Each sh In f2.Worksheets
                    sh.Cells(prod, 1).Value = ComboBox_lot.Value
                    sh.Cells(prod, 4).Value = TextBox2.Value
                    sh.Cells(prod, 2).Value = TextBox4.Value
                    sh.Cells(prod, 3).Value = TextBox5.Value
                    sh.Cells(prod, 37).Value = TextBox6.Value
            Next sh
    Next f2
Next f1



Mais ça ne marche pas...Si vous pouvez m'éclairer!

Meri
Messages postés
14008
Date d'inscription
samedi 29 décembre 2001
Statut
Modérateur
Dernière intervention
28 août 2015
81
Bah comme tu l'as fait.
Je pense que cela doit marcher, sauf que ce que tu énumères dans ton 'For Each', ce sont les fichiers, pas des classeurs.
Donc il te faut une variable intermédiaire, genre :
    Dim unFichier As Object
    ...
    For Each unFichier In Fso.GetFile(racine1).Files
        Set f2 =  Workbooks.Open(Racine1 & "" & unFichier)
        For Each sh In f2.Worksheets
        ...
Vérifier si le contenu de unFichier englobe déjà le chemin ou uniquement le nom du fichier.

Vala
Jack, MVP VB
NB : Je ne répondrai pas aux messages privés

Le savoir est la seule matière qui s'accroit quand on la partage (Socrate)
Ok c'est bon ça marche nickel j'arrive à tout mettre à jour avec cette macro. J'ai utilisé une autre déclaration de f2.

Voici le code:

Private Sub CommandButton1_Click()

Dim Fso As Object
Dim racine As String
Dim racine1 As String
Dim Files As Object
Dim f1 As Object
Dim fichier As Object
Dim f2 As Object
Dim f3 As Workbook
Dim sh As Worksheet
Dim prod As Integer
prod = 26


While Sheets("Complet").Cells(prod, 1).Value <> ""
    prod = prod + 1
Wend


Sheets("Complet").Cells(prod, 1).Value = ComboBox_lot.Value
Sheets("Complet").Cells(prod, 4).Value = TextBox2.Value
Sheets("Complet").Cells(prod, 2).Value = TextBox4.Value
Sheets("Complet").Cells(prod, 3).Value = TextBox5.Value
Sheets("Complet").Cells(prod, 37).Value = TextBox6.Value

Set Fso = CreateObject("Scripting.FileSystemObject")
racine = "C:\Users\Loic\Desktop\SORTIES1\DATA"

For Each f1 In Fso.getfolder(racine).SubFolders
        racine1 = f1
        Set f2 = Fso.getfolder(f1.Path).Files
    For Each f2 In f1.Files
            Set f3 = Workbooks.Open(f2)
                    For Each sh In f3.Worksheets
                            sh.Cells(prod - 15, 1).Value = ComboBox_lot.Value
                            sh.Cells(prod - 15, 4).Value = TextBox2.Value
                            sh.Cells(prod - 15, 2).Value = TextBox4.Value
                            sh.Cells(prod - 15, 3).Value = TextBox5.Value
                            sh.Cells(prod - 15, 37).Value = TextBox6.Value
                            sh.Activate
                            Range("A" & prod - 15 & ":" & "AL" & prod - 15).Select
                            Selection.Borders(xlDiagonalDown).LineStyle = xlNone
                            Selection.Borders(xlDiagonalUp).LineStyle = xlNone
                                With Selection.Borders(xlEdgeLeft)
                                        .LineStyle = xlContinuous
                                        .ColorIndex = 0
                                        .TintAndShade = 0
                                        .Weight = xlThin
                                End With
                                With Selection.Borders(xlEdgeTop)
                                        .LineStyle = xlContinuous
                                        .ColorIndex = 0
                                        .TintAndShade = 0
                                        .Weight = xlThin
                                End With
                                With Selection.Borders(xlEdgeBottom)
                                        .LineStyle = xlContinuous
                                        .ColorIndex = 0
                                        .TintAndShade = 0
                                        .Weight = xlThin
                                End With
                                With Selection.Borders(xlEdgeRight)
                                        .LineStyle = xlContinuous
                                        .ColorIndex = 0
                                        .TintAndShade = 0
                                        .Weight = xlThin
                                End With
                                With Selection.Borders(xlInsideVertical)
                                    .LineStyle = xlContinuous
                                    .ColorIndex = 0
                                    .TintAndShade = 0
                                    .Weight = xlThin
                                End With
                                With Selection.Borders(xlInsideHorizontal)
                                    .LineStyle = xlContinuous
                                    .ColorIndex = 0
                                    .TintAndShade = 0
                                    .Weight = xlThin
                                End With
                    Next sh
        ActiveWorkbook.Save
        ActiveWorkbook.Close
    Next f2
Next f1

UserForm1.Hide

End Sub



Par contre c'est super long. Est ce qu'il y aurait moyen d'optimiser le code pour que cela aille plus vite (par exemple ouvrir chaque fichier sans les voir) ou simplifier les boucles etc...

Merci et bonne soirée,

Ludo
Messages postés
172
Date d'inscription
jeudi 8 décembre 2011
Statut
Membre
Dernière intervention
21 juillet 2013
2
Bonjour !   Plus t'utilises de .Select et plus c'est long !
            Il est préférable de travailler directement avec les objets ...

Par exemple au lieu de
     Range("A" & prod - 15 & ":" & "AL" & prod - 15).Select
     Selection.Borders(xlDiagonalDown).LineStyle = xlNone
     Selection.Borders(xlDiagonalUp).LineStyle = xlNone

mieux vaut
    With Range("A" & prod - 15 & ":" & "AL" & prod - 15)
        .Borders(xlDiagonalDown).LineStyle = xlNone
          .Borders(xlDiagonalUp).LineStyle = xlNone
    End With


Ensuite pour ne rien voir, il faudrait en début de code insérer
    Application.ScreenUpdating = False

___________________________________________________________________________________________________________________
Comme la vitesse de la lumière est supérieure à celle du son, certains ont l'air brillant avant d'avoir l'air con !
Ok c'est bon ça marche nickel !

Merci beaucoup pour votre aide.
Pour éviter de créer un nouveau sujet je pose ma nouvelle petite question ici :
En fait chaque .xlsm a un nom commençant par un numéro.
je voulais remplir une textbox automatiquement par la valeur "numéro de fichier le plus important +1".
J'ai pas mal farfouillé sur internet mais pas trouvé grand chose.
Si vous avez une piste...

Bon aprem,

Ludo
Messages postés
172
Date d'inscription
jeudi 8 décembre 2011
Statut
Membre
Dernière intervention
21 juillet 2013
2
Parlant de .xlsm, j'en déduis que c'est une version 2007
(que j'ai vite abandonnée pour rester en 2003)
ou 2010 (à laquelle je résiste par faute de moyen et de temps),
vaut mieux ouvrir un nouveau sujet (en précisant cette fois la version)
et en y détaillant un peu plus l'accès aux fichiers dans la procédure ...

___________________________________________________________________________________________________________________
Comme la vitesse de la lumière est supérieure à celle du son, certains ont l'air brillant avant d'avoir l'air con !
Salut MarcPL et merci pour ta réponse.

J'ai finalement opté pour une autre solution un peu bricolé mais qui fonctionne.
J'ai utilisé la fonction mid qui récupère les caractères voulues dans une variable de type string à l'endroit souhaité (le numéro que je voulais récupéré était toujours situé à la même place dans le nom de fichier).

Voilà ce que ça donne:

For Each Objet In dossier.SubFolders
        racine1 = Objet & ""
        Set dossier_racine1 = fs.getfolder(racine1)
                For Each chantier In dossier_racine1.Files
                    Sheets("Complet").Cells(i, 1) = Objet.Name
                    Dim MaStr As String
                    MaStr = chantier.Name
                    Sheets("Complet").Cells(i, 2) = Mid(MaStr, 7, 3)
                    i = i + 1
                Next
Next