Discussion :

[Thierry360]

Bonjour,

J’ai récupéré un code vba et l’ai retravaillé afin qu’il corresponde à mes besoins :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
 
Option Explicit
Sub MergeAllWorkbooks()
    Dim MyPath As String, FilesInPath As String
    Dim MyFiles() As String
    Dim Repertoire As FileDialog
    Dim ligne As Long
 
    Set Repertoire = Application.FileDialog(msoFileDialogFolderPicker)
    If Repertoire.Show = False Then Exit Sub
    MyPath = Repertoire.SelectedItems(1)
    If Right(MyPath, 1) <> "\" Then
        MyPath = MyPath & "\"
    End If
 
    FilesInPath = Dir(MyPath & "*.xl*")
 
   With Application
        .Calculation = xlCalculationManual
        .ScreenUpdating = False
        .EnableEvents = False
    End With
 
        ' création d'autant de nouvelles lignes qu'il y a de fichiers : on compte le nombre de fichiers avec un "do while xxx <>"", on copie une ligne formatée au format souhaité et on insère le nombre de lignes correspondantes. Cela n'a pas l'air de prendre beaucoup de temps car si j'exécute seulement ce bout de code cela fonctionne rapidement sur des dossier avec 300 fichiers excel...
 
    Do While FilesInPath <> ""
        filep = MyPath & FilesInPath
        FilesInPath = Dir()
 
        Range("B" & ligne).Formula = "='" & filep & "'!toto1"
        Range("C" & ligne).Formula = "='" & filep & "'!toto2"
        Range("D" & ligne).Formula = "='" & filep & "'!toto3"
 
        (idem sur une quarantaine de colonnes !)
 
        ligne = ligne + 1
    Loop
 
ExitTheSub:
    With Application
        .ScreenUpdating = True
        .EnableEvents = True
        .Calculation = xlCalculationAutomatic
    End With
End Sub

Cela marche bien quand il y a une dizaine de fichiers excel dans le dossier mais je reçois une erreur 400 quand il y a beaucoup de fichiers excel.

Je suppose que cela vient du fait que ma boucle n'est pas assez performante.
Je crois que c'est l'insertion d'une quarantaine de formule sur chaque ligne qui doit poser problème mais je ne vois pas comment optimiser ça ?

Pourriez-vous m’aider svp ?

J'ai pensé à inscrire mes nom de cellules (toto1, toto2, toto3, ...) dans la ligne supérieur du tableau excel (en ligne 1 par exemple) une fois pour toutes pour ensuite insérer uniquement sur la première colonne une formule du type

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

=chemin du fichier excel.xls'! & INDIRECT("A1")

... et étendre les formule jusqu'à la fin du tableau (après être sorti de la boucle).
Je pensais que cela serait moins consommateur de ressources.
Mais ça ne semble pas marcher (#REF).
Est-ce une piste à creuser selon vous... ?

[Oliv-]

Salut,
Peux tu expliquer ce que tu veux obtenir ?
Pour parcourir des fichiers il vaut mieux utiliser FSO

[Thierry360]

Je veux créer un tableau de synthèse de plusieurs fichiers excel.
Tous ces fichiers excel ont des cellules nommées de façon identique (toto1 est le nom d'une cellule présente dans tous les fichiers excel).

Le tableau est structuré ainsi :
- 1 ligne par fichier
- 40 colonnes, avec une variable par colonne (même fichier mais référence à une cellule nommée différemment)

Toutes les cellules du tableau doivent être remplies avec des liens (et pas directement avec les valeurs des cellules en dur).

[mercatog]

Bonjour

j'ai testé ton code (avec un léger remaniement) sur 750 fichiers et 120 colonnes sans erreur

J'ai ajouté un dovents

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
Sub MergeAllWorkbooks()
Dim MyPath As String, FilesInPath As String, Filep As String
Dim Repertoire As FileDialog
Dim Ligne As Long
 
With Application
    .Calculation = xlCalculationManual
    .ScreenUpdating = False
    .EnableEvents = False
End With
 
Set Repertoire = Application.FileDialog(msoFileDialogFolderPicker)
If Repertoire.Show = True Then
    MyPath = Repertoire.SelectedItems(1)
    Set Repertoire = Nothing
 
    If Right(MyPath, 1) <> "\" Then MyPath = MyPath & "\"
 
    FilesInPath = Dir(MyPath & "*.xl*")
    Do While FilesInPath <> ""
        Filep = Replace(MyPath & FilesInPath, "'", "''")    'Au cas où le nom contient l'apostrophe
 
        Ligne = Ligne + 1
        Range("B" & Ligne).Formula = "='" & Filep & "'!toto1"
        Range("C" & Ligne).Formula = "='" & Filep & "'!toto2"
        Range("D" & Ligne).Formula = "='" & Filep & "'!toto3"
        DoEvents
        FilesInPath = Dir()
    Loop
End If
 
With Application
    .ScreenUpdating = True
    .EnableEvents = True
    .Calculation = xlCalculationAutomatic
End With
End Sub

[Thierry360]

Merci mercatog !

Si j'ai bien compris "DoEvents" permet d'attendre la fin de l'exécution du code au lieu de laisser le programme planter automatiquement au bout de x secondes ?

Cela semble très bien marcher effectivement.

En revanche l'utilisateur a un curseur de souris « classique » s’affiche.
Y a-t-il un moyen visuel efficace pour indiquer que le programme est bien en train d’agir ?

Je pensais à remplir une cellule avec un texte « Programme en cours » au début du code et à supprimer son contenu à la fin du code.

[mercatog]

Ajoute au début

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
With Application
    .Calculation = xlCalculationManual
    .ScreenUpdating = False
    .EnableEvents = False
    .Cursor = xlWait
    .StatusBar = "En cours de traitement...."
End With

Et à la fin

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
With Application
    .ScreenUpdating = True
    .EnableEvents = True
    .Calculation = xlCalculationAutomatic
    .Cursor = xlDefault
    .StatusBar = False
End With
MsgBox "Traitement terminé"

[Thierry360]

Parfait !
Merci encore !