Ajout pourcentage barre progression

Bonjour à tous,

Je vous sollicite pour mon fichier excel, je souhaite ajouter une barre de progression pendant l'exécution de la macro VBA qui se lance dès l'ouverture du fichier.

Sachant que la macro peut prendre plusieurs minutes, il est nécessaire que j'ajoute une barre de progression qui se ferme automatique lorsque la macro est terminée.

Edit : Si je passe par vous, c'est que je n'ai pas réussi à trouver une barre de progression qui s'exécute sur une macro qui se lance au démarrage et je n'ai pas réussi l'adaptation ...

Merci d'avance pour voter aide.

Je me permets de répondre pour up le message

Bonjour,

pour pouvoir afficher un état d'avancement, il faut connaitre un nombre final à atteindre. Or ce nombre on ne le connait que lorsque la macro est terminée. Tout au plus pourrait-on afficher l'état d'avancement à propos du nombre de fichiers ou du nombre de sous-répertoires dans le répertoire en cours.

si tu disposes de cette information, on peut afficher le % dans la barre de statut de la manière suivante

Private Sub Workbook_Open()

Application.ScreenUpdating = False
With Me
    .Sheets(1).Range("A:Z").Clear
    nn = 1000 'nombre de fichiers à lire
    Parcourir .Path
    .Sheets(1).Range("A:Z").Value = .Sheets(1).Range("A:Z").Value
End With
Application.ScreenUpdating = True

End Sub

Public n&, nn& 'variables pour la barre de statut

Function Parcourir(spath$)

Dim DerniereLignePlanExe As Integer
Dim DerniereLigneNdc As Integer
Dim DerniereLignePlanFab As Integer

Set fso = CreateObject("Scripting.filesystemobject")
Set ofolder = fso.getfolder(spath)
For Each osubfolder In ofolder.subfolders
    For Each ofile In osubfolder.Files
    ' on compte les fichiers lus
    n = n + 1
    Application.StatusBar = Format(n / nn, "0.00%") 'on affiche le % de progression sur la barre de statut

        If ofile.Path Like "*.xls*" And ofile.Name Like "Fiche de suivi*" Then
            With Workbooks.Open(ofile.Path)
                If .Sheets.Count >= 2 Then
                    ThisWorkbook.Sheets(1).Range("B" & (DerniereLigne + 4), "Q" & (DerniereLigne + 4)).MergeCells = True
                    .Sheets(1).Range("D5:S5").Copy ThisWorkbook.Sheets(1).Range("B" & (DerniereLigne + 4), "Q" & (DerniereLigne + 4))
                    .Sheets(2).Range("O1:S100").Copy ThisWorkbook.Sheets(1).Range("B" & (DerniereLigne + 5))
                    .Sheets(2).Range("V1:Z100").Copy ThisWorkbook.Sheets(1).Range("I" & (DerniereLigne + 5))
                    .Sheets(2).Range("AG1:AH100").Copy ThisWorkbook.Sheets(1).Range("P" & (DerniereLigne + 5))
                    DerniereLignePlanExe = ThisWorkbook.Sheets(1).Range("B" & Rows.Count).End(xlUp).Row
                    DerniereLigneNdc = ThisWorkbook.Sheets(1).Range("I" & Rows.Count).End(xlUp).Row
                    DerniereLignePlanFab = ThisWorkbook.Sheets(1).Range("P" & Rows.Count).End(xlUp).Row
                    If DerniereLignePlanExe >= DerniereLigneNdc And DerniereLignePlanExe >= DerniereLignePlanFab Then
                        DerniereLigne = DerniereLignePlanExe
                        Else
                        If DerniereLigneNdc >= DerniereLignePlanFab Then
                            DerniereLigne = DerniereLigneNdc
                        Else
                        DerniereLigne = DerniereLignePlanFab
                        End If
                    End If
                End If
                .Close False 'ferme le classeur source sans enregistrer
            End With
        End If
    Next ofile
    Parcourir = Parcourir(osubfolder.Path)
Next osubfolder
End Function

Bonjour et merci pour votre aide. Désolé pour mon retard

J'ai deux questions :

1 - A quoi sert la ligne :

 .Sheets(1).Range("A:Z").Value = .Sheets(1).Range("A:Z").Value

2 - Lorsque je lance la macro, j'ai une erreur sur cette ligne :

 Application.StatusBar = Format(n / nn, "0%")

J'ai déplacé la ligne nn = 1000 dans la fonction pensant que le problème venait de là. Le code s'exécute mais la barre n'apparait pas.

Je ne comprends pas d'où vient/viennent l'erreur/ les erreurs

Après avoir de nouveau regardé le code, j'ai compris deux points.

1 - Le % s'affiche bien mais tout en bas à gauche du fichier excel, je préfèrerait l'avoir au milieu de l'écran dans une fenêtre afin qu'il soit plus visible car si on ne sait pas que le % s'affiche dans le coin, on ne peut pas savoir si le fichier est totalement chargé ou pas

2 - Le % s'exécute mais dans les sous dossiers, ce qui fait qu'il monte de 0% à 100% pour chaque dossier et non sur l'ensemble de la procédure

Bonjour,

réponses à ta première paire de questions

1) à quoi sert la ligne ..., à mon avis, à rien, mais c'est ton code je n'ai pas touché à cette partie.

2) erreur (quelle erreur ?) peut-être une erreur de format essaie alors avec 0,00% plutôt que 0.00%

réponses à ta deuxième paire de questions

1) ben oui c'est que je t'ai proposé (barre de statut). Si cela ne te convient pas d'autres solutions ici par exemple

https://forum.excel-pratique.com/excel/userform-d-avancement-de-traitement-154136

2) si tu déplaces les instructions nn dans la fonction, c'est normal.

Ha je vois

C'est exactement ce fichier sur lequel je voulais m'appuyer lorsque j'avais écrit mon message initial mais je n'avais pas réussi à l'adapter. Je vais réessayer de nouveau. Je vous tiens au courant. Merci

re-bonjour,

intégration de la barre de progression dans ton fichier + ajout d'une sub pour compter le nombre de fichiers à examiner

C'est exactement ce que je voulais faire.

Je vais essaye de comprendre comment se font les liens entre les fonctions et les sub et les modules.

Encore Merci !