Import de fichiers avec progressbar ou message défilant le nombre & noms des fichiers

[KIM]

Bonjour les ami(e)s et le forum,
Je tiens à vous remercier de toute l'aide que vous m'avez apportée à plusieurs reprises et récemment Softmama dans sa macro de lecture de fichiers fermés et recopie dans un seul fichier (merci encore). Le nombre de fichiers dépasse les 2000 fichiers et l'utilisateur a l'impression que la procédure n'avance pas. J'ai voulu intégrer une progressbar et malgré les plusieurs exemples dans ce forum je n'ai pas réussi à en intégrer une dans l'import de mes fichers. Je reviens vers vous pour vous solliciter à m'aider. Ci-joint le fichier d'import avec un exemple de progressbar qui donne:
- le nombre total des fichiers à importer
- le nombre de fichiers importés
avec un message : J'en suis à n fichiers lus sur xxxx fichiers à importer (voir col J)
- le temps d'éxecution
- la barre de progression avec le taux de progression
- et l'affichage des noms des fichiers importés.

A rajouter dans la progressbar un bouton ( OK ) qui s'active à la fin de la procédure pour la fermer pour éviter que la progressbar disparait automatiquement en fin de procédure.

Comment intégrer cette progressbar dans l'imporatation de mes fichiers?
Si vous avez une autre solution d'attente et bien visible de l'utilisateur, j'en suis preneur.
Merci de votre aide
KIM

 

[BOISGONTIER]

Re : Import de fichiers avec progressbar ou message défilant le nombre & noms des fic

Bonjour,


Voir ex en pj

JB

 

[Softmama]

Re : Import de fichiers avec progressbar ou message défilant le nombre & noms des fic

Bonjour Kim, Salutations BOISGONTIER,

Je me suis permis, Kim, d'intégrer ta Progressbar dans ton fichier en rajoutant et modifiant 2-3 macros :

Déclaration de 3 variables en Public :

Public TotalFichiers As Integer, Tdepart, FichEnCours As Integer

Nouvelle Macro Scan(Répertoire) qui renvoie le nbre total de fichiers que tu as à traiter :

Sub Scan(Répertoire)
'Détermine le nbre de fichiers qu'il va y avoir à traiter
    Dim Fso As Scripting.FileSystemObject
    Dim RépSource As Scripting.Folder
    Dim SousRép As Scripting.Folder
    Dim Fichier As Scripting.File
    
    Set Fso = CreateObject("Scripting.FileSystemObject")
    Set RépSource = Fso.GetFolder(Répertoire)
    Application.ScreenUpdating = False
    For Each Fichier In RépSource.Files
        If Right$(Fichier, 8) = "SURF.xls" Then
            TotalFichiers = TotalFichiers + 1
        End If
    Next Fichier
    '--- Appel récursif pour lister les fichiers dans les sous-répertoires ---.
    For Each SousRép In RépSource.subfolders
        Scan SousRép.Path
    Next SousRép
End Sub

Modifications dans la macro Go():

Sub Go()
'Pour lancer le scan en choisissant le répertoire où scanner + ses sous répertoires
 With Application
      .DisplayAlerts = False
      .ScreenUpdating = False
   If Sheets("Menu").Range("B2") = "" Then Lepath = QuelRépertoire Else Lepath = Sheets("Menu").Range("B2")
   Sheets("Menu").Range("B2") = Lepath
   Sheets("Menu").Range("B3:B4") = 0
    Sheets("RecapG").Range("A11:W65536").ClearContents
    Sheets("RecapSG").Range("A11:I65536").ClearContents
    FichEnCours = 0: TotalFichiers = 0
    Scan Lepath 'Recupération du nbre de fichiers total à scanner
    tDate = Now
   Recopie Lepath 'Démarrage de l'opération
      .DisplayAlerts = True
      .ScreenUpdating = True
    frmZavancement.Label2.Caption = "Terminé !"
End With
End Sub

Modifications dans la macro Recopie(Répertoire):

Sub Recopie(Répertoire)
    Dim c As Range, d As Range, nOnglet As String
    Dim Fso As Scripting.FileSystemObject
    Dim RépSource As Scripting.Folder
    Dim SousRép As Scripting.Folder
    Dim Fichier As Scripting.File
    
    Set Fso = CreateObject("Scripting.FileSystemObject")
    Set RépSource = Fso.GetFolder(Répertoire)
    Application.ScreenUpdating = False
    Sheets("Menu").Range("B3") = Sheets("Menu").Range("B3") + 1
    For Each Fichier In RépSource.Files
        If Right$(Fichier, 8) = "SURF.xls" Then 'Recherche des fichiers *SURF.xls
            With frmZavancement
                FichEnCours = FichEnCours + 1
                .Label1.Caption = "J'en suis à " & FichEnCours & " sur " & TotalFichiers & "."
                .Label2.Caption = Format(CDate(Now - Tdepart), "N:ss")
                .FrameProgress.Caption = Format(FichEnCours / TotalFichiers, "0%")
                .LabelProgress.Width = FichEnCours / TotalFichiers * (.FrameProgress.Width - 10)
                .Show 0 'Affichage Progressbar en non modal
            End With
            nOnglet = RechFermé(RépSource & "\" & Fichier.Name) 'ADO Pour trouver le nom du 1er onglet
            Set c = Sheets("RecapG").Range("D" & Sheets("RecapG").Range("d65536").End(xlUp).Row + 1)
            Set d = Sheets("RecapSG").Range("D" & Sheets("RecapSG").Range("d65536").End(xlUp).Row + 1)
            d(1, -2) = Répertoire
            d(1, -1) = Fichier.Name
            d(1, 0) = nOnglet
            For t = 1 To 7
                d(1, t).Formula = "='" & Répertoire & "\[" & Fichier.Name & "]" & nOnglet & "'!B" & t
                d(1, t) = d(1, t)
            Next t
            Sheets("Menu").Range("B4") = Sheets("Menu").Range("B4") + 1
            t = 8
1           t = t + 1
            c.Offset(t - 9, 0).Formula = "='" & Répertoire & "\[" & Fichier.Name & "]" & nOnglet & "'!A" & t
                If c.Offset(t - 9, 0).Value = 0 Then c.Offset(t - 9, 0).Clear Else GoTo 1
                t = t - 1
                Range(c, c(t - 8, 1)).AutoFill Range(c, c(t - 8, 23))
                Range(c, c(t - 8, 23)).Value = Range(c, c.Offset(t - 8, 22)).Value
                c(1, -2).Resize(t - 8) = Répertoire
                c(1, -1).Resize(t - 8) = Fichier.Name
                c(1, 0).Resize(t - 8) = nOnglet
        End If
    Next Fichier
    '--- Appel récursif pour lister les fichiers dans les sous-répertoires ---.
    For Each SousRép In RépSource.subfolders
        Recopie SousRép.Path
    Next SousRép
End Sub

Ha et puis j'ai viré les USF_Initialize qui servent à rien
Espérant avoir répondu à tes attentes.

 

[KIM]

Re : Import de fichiers avec progressbar ou message défilant le nombre & noms des fic

Bonjour le fil,
@Softmama,
Merci d'avoir intégré la progressbar dans la procédure d'import. Je viens de la tester sur presque 100 fichiers.
1- Je n'ai pas vu le défilement de la progressbar. L'écran est gelé et elle apparait directement à 100% terminé en fin d'éxécution.
2- Est-il possible de conserver le chrono du temps d'éxécution et d'avoir à coté ou sous la barre de défilement le message "Terminé" en fin d'éxécution. Merci encore.

@BOISGONTIER
J'ai essayé d'éxécuter ta macro sur un ensemble de 100 fichiers. J'ai modifié le type de fichiers en "*SURF.xls" et Rien ne se passe.
J'ai essayé aussi "*.xls", Une fois la barre de progression est apparue à l'écran et ensuite plus rien. J' n'ai pas su d'ou provient le problème.

En attendant, merci de votre aide si précieuse.
KIM

 

[Softmama]

Re : Import de fichiers avec progressbar ou message défilant le nombre & noms des fic

Re,

Dans la procédure Recopie(Répertoire), pllace un

    .Repaint

juste avant le

    .Show 0

 

[KIM]

Re : Import de fichiers avec progressbar ou message défilant le nombre & noms des fic

Re le fil
@Softmama,
Oui cela fonctionne, Merci.
J'ai aussi rajouté un Label3 pour afficher "Terminé!" et conserver le temps d'éxecution dans le Label2.

Merci encore et à Bientôt
KIM

 

[KIM]

Re : Import de fichiers avec progressbar ou message défilant le nombre & noms des fic

Re le fil,
@Softmama,
Je reviens vers toi concernant la progressBar. Je l'ai testée sur 200 fichiers. Effectivement la progression de progressbar se fait fichier par fichier. Est-il possible d'intégrer un "pas" de "n" fichiers de progréssion de la barre, avec n = 1, 5, 10, 50, 100. Je peux fixer "n" en fonction du nombre de fichiers à importer. Cela nous fait gagner du temps dans l'exécution de la progressbar. Qu'en pense-tu?

Merci d'avance
KIM

 

[Softmama]

Re : Import de fichiers avec progressbar ou message défilant le nombre & noms des fic

Bonsoir,

A mon avis, le temps que tu vas gagner, s'il existe est vraiment insignifiant. Faire une division et les afficher dans un label n'est pas très gourmand en ressources et ne devrait pas ralentir ta macro de plus d'un ou 2% à mon avis. Fais un test avec et sans progressbar et compare la différence de temps d'exécution, mais à mon sens, ça ne doit pas être très significatif.

Ceci dit, si tu veux ne raffraichir le compte que tous les 23 fichiers, par exemple, tu peux faire comme ceci :
Remplace:

           With frmZavancement
                FichEnCours = FichEnCours + 1
                .Label1.Caption = "J'en suis à " & FichEnCours & " sur " & TotalFichiers & "."
                .Label2.Caption = Format(CDate(Now - Tdepart), "N:ss")
                .FrameProgress.Caption = Format(FichEnCours / TotalFichiers, "0%")
                .LabelProgress.Width = FichEnCours / TotalFichiers * (.FrameProgress.Width - 10)
                .Show 0 'Affichage Progressbar en non modal
           End With

par:

           With frmZavancement
                FichEnCours = FichEnCours + 1
                If  FichEnCours Mod 23 = 0 Or FichEnCours = TotalFichiers then
                    .Label1.Caption = "J'en suis à " & FichEnCours & " sur " & TotalFichiers & "."
                    .Label2.Caption = Format(CDate(Now - Tdepart), "N:ss")
                    .FrameProgress.Caption = Format(FichEnCours / TotalFichiers, "0%")
                    .LabelProgress.Width = FichEnCours / TotalFichiers * (.FrameProgress.Width - 10)
                    .Show 0 'Affichage Progressbar en non modal
                End If
           End With

Je te laisse tester.

 

[KIM]

Re : Import de fichiers avec progressbar ou message défilant le nombre & noms des fic

Bonsoir le fil,
Tu as raison Softmama, j'ai déjà fait le test sur les 200 fichiers avec ou sans progressbar. Je n'ai perdu que 4 secondes. pour les 2000 fichiers j'extrapole à 40 sec càd moins d'une minute. Ce qui est très correct.
Avec tes dernières modifs, au moins j'ai appris comment faire si c'est nécessaire.
Merci et A bientôt.

Bonne soirée
KIM

 

[KIM]

Re : Import de fichiers avec progressbar ou message défilant le nombre & noms des fic

Bonjour les ami(e)s, bonjour le forum,
@Softmama,
Depuis plus de 10jours j'utilise ta macro d'import de fichiers fermés et là j'intègre la progressbar comme tu me l'as indiqué. Je lance la macro ce matin et quelle surprise de retrouver des formules non éxécutées dans le fichier récapitulatif. J'ai lancé la procédure Go_F sur d'autres répertoires. A chaque fois, la macro remplit les formules dans des cellules en format texte et les exécute seulement à partir du 2ième fichier lu (voir feuille RecapSurf). Dans la macro d'origine, j'ai intégré le formatage texte de la col 4 (Niv). Le fait de supprimer n'a pas réglé le problème. Je ne comprend plus rien et là je suis bloqué.
Merci de votre aide
KIM

 

[Softmama]

Re : Import de fichiers avec progressbar ou message défilant le nombre & noms des fic

Bonjour KIM,

Apparemment, le format texte est mal apprécié par les formules. En passant toute la feuille au format Standard, le problème disparaît. Ne me demande juste pas pourquoi : je l'ignore.

 

[KIM]

Re : Import de fichiers avec progressbar ou message défilant le nombre & noms des fic

Re,
Merci, Cela me dépanne mais le problème rest aléatoire.

J'en profite pour vous souhaiter à vous tou(te)s de bonnes fêtes de Noêl et de fin d'année.

KIM