Barre de progression

Question

J'ai essayé de mettre dans mon code en m’appuyant sur www.excel-pratique.com/fr/astuces_vba/progress_bar.php que je remercie. Le résultat n'est que partiellement correct. L'userform se comporte correctement, sauf l'activité de progression. Normale puisque je ne sais pas comment la mettre en place dans ce mon code. Mon code: 'PROCEDURE INIALISATION DU DOSSIER ' En 1- METTRE "PE" DANS COLONNE D A PARTIR DE LA LIGNE 3 SI CELLULE B N'EST PAS VIDE sur toutes les feuilles Private Sub Btn_InitDossier_Click() Dim plage As Range Dim I%, y% Dim derlig As Long Dim Data As Long Application.ScreenUpdating = False 'Désactive l'actualisation de l'écran For I = 3 To Worksheets.Count With Worksheets(I) For y = 3 To .Cells(.Rows.Count, 2).End(xlUp).Row If Not IsEmpty(.Cells(y, 3)) Then 'Vérifie que la cellule à gauche n'est pas vide .Range(.Cells(y, 4), .Cells(y, 10)).ClearContents 'Raz des informations précédentes .Cells(y, 4) = "PE" 'Ecriture Pas Essayer "PE" .Columns("G:I").EntireColumn.Hidden = True ' Choix des colonnes a masquer pour saisir les informations: Columns("G:I") étant la phase corrective sur "N" End If Next y End With Next I ' En 2- RECUPERE LES NOMS D'ONGLETS ET COMPTE LE NBRE DE "PE" APRES "INIT DOSSIER" PRESENT DANS CHAQUE ONGLET Worksheets("DATA").Activate 'Activation Feuille "DATA" DerLig_Data = Sheets("DATA").Range("D" & Rows.Count).End(xlUp).Row 'détermine la dernière ligne If DerLig_Data &gt; 8 Then Sheets("DATA").Range("D9:E" & DerLig_Data).ClearContents 'si la dernière ligne est la 8, on fait rien sinon, on efface tout ce qui est en dessous For I = 1 To Sheets.Count If Sheets(I).Name &lt;&gt; "DATA" And Sheets(I).Name &lt;&gt; "ADMINISTRATEUR" Then 'toutes les feuilles sauf "DATA" et "ADMINISTRATEUR" PosTiret = InStr(1, Sheets(I).Name, "-", 1) 'relevé de l'emplacement du tiret dans le nom de l'onglet Tbl = Left(Sheets(I).Name, PosTiret - 1) With Sheets("DATA") 'Choix de la l'onglet "DATA" .Cells(9 + I - 3, "D") = Sheets(I).Name 'Nom de l'onglet .Cells(9 + I - 3, "G") = Sheets(I).Name 'Nom de l'onglet .Range("E" & 9 + I - 3) = "=COUNTIF(" & Tbl & "&#91;CONFORME O / N / PE&#93;,""PE"")" 'Data Taleau Statique .Range("K" & 9 + I - 3) = "=COUNTIF(" & Tbl & "&#91;CONFORME O / N / PE&#93;,""PE"")" 'Data Taleau Dynamique (Pour Datas Courbes Barres) End With End If Next I DerLig_Data = Worksheets("DATA").Range("D" & Rows.Count).End(xlUp).Row 'détermine la dernière ligne If DerLig_Data &gt; 8 Then With Sheets("DATA") .Range("D9:E" & DerLig_Data).Value = Range("D9:E" & DerLig_Data).Value 'remplacement des formules par leurs valeurs .Range("K9:K" & DerLig_Data).Value = Range("K9:K" & DerLig_Data).Value 'remplacement des formules par leurs valeurs End With End If ' En 3- METTRE A JOURS LA LISTE DES ONGLETS DANS "ADMINISTRATEUR" Call MJLIST_Onglet 'Appel module MJLIST_Onglet Init_Dossier.Height = 140 'définition hauteur UserForm "Init_Dossier" à la fermeture ' MsgBox "Toutes les feuilles sont mises à jour", vbInformation ' Worksheets("DATA").Visible = False 'Cache la feuille "DATA" End Sub Je n'ai pas mis mon fichier (trop de données confidentielles), pour info : Si cela est nécessaire , je ferai un support. Merci par avance. Bonne journée au forum...

LouReeD · Answer

A première vue vous avez deux boucles "principales", il vous faut déterminer leur proportion par rapport aux 100% de la barre de progression. A voir aussi combien de "temps" dure la procédure MJLIST_Onglet. Mais l'idée est là : première boucle correspondant à 60% et la seconde à 40 %, l'image_barre ayant une taille finie de 150, la première boucle la fera avancer de 60% soit 60*150/100 = 90 et la deuxième boucle de 60, elle sera donc à 100% à la fin des deux boucle (je part du principe que la dernière procédure n'est pas longue) Pour la première boucle, la barre devra avancer de 90/par le nombre de boucle, soit dans votre exemple : 90/Worksheets.Count mais comme il y a une autre boucle imbriquée chaque portion devra également être divisée par le compteur de cette boucle (90/WorkSheets.count) / .Cells(.Rows.Count, 2).End(xlUp).Row Vous trouvez ainsi la valeur d'avancement pour chaque "sous boucle" et cette valeur d'avancement sera proportionnel à chaque compteur. Pour la deuxième boucle c'est plus simple il n'y en a qu'une, donc le principe est le même 60/Sheets.Count Le découpage étant mis en variable, la valeur d'avancement devra être ajouté à la taille de l'image de la barre pour la faire avancée. @ bientôt LouReeD...

LouReeD · Answer

Un essai d'intégration :

'PROCEDURE INIALISATION DU DOSSIER

' En 1- METTRE "PE" DANS COLONNE D A PARTIR DE LA LIGNE 3 SI CELLULE B N'EST PAS VIDE sur toutes les feuilles

Private Sub Btn_InitDossier_Click()
    Dim plage As Range
    Dim I%, y%
    Dim derlig As Long
    Dim Data As Long

    '******************** LouReeD
    Dim Taille_Barre, Segment_Barre, Taille, NB_Lignes
    UserForm_demo.Show

    Application.ScreenUpdating = False  'Désactive l'actualisation de l'écran

    ' ******************* LouReeD
    ' on part du principe que la première double boucle prend 60% de la barre
    Taille = 90

    For I = 3 To Worksheets.Count
         With Worksheets(I)

            '****** LouReeD
            NB_Lignes = .Cells(.Rows.Count, 2).End(xlUp).Row
            Segment_Barre = (Taille / Worksheets.Count) / NB_Lignes

             For y = 3 To NB_Lignes
                If Not IsEmpty(.Cells(y, 3)) Then                       'Vérifie que la cellule à gauche n'est pas vide
                    .Range(.Cells(y, 4), .Cells(y, 10)).ClearContents   'Raz des informations précédentes
                    .Cells(y, 4) = "PE"                                     'Ecriture Pas Essayer "PE"
                    .Columns("G:I").EntireColumn.Hidden = True             ' Choix des colonnes a masquer pour saisir les informations: Columns("G:I") étant la phase corrective sur "N"
                End If

                '****** LouReeD
                Image_barre.Width = Image_barre.Width + Segment_Barre
                Label_barre.Caption = Image_barre.Width * 1.5 & "%"
                DoEvents

             Next y
        End With
    Next I

' En 2- RECUPERE LES NOMS D'ONGLETS ET COMPTE LE NBRE DE "PE" APRES "INIT DOSSIER" PRESENT DANS CHAQUE ONGLET

   Worksheets("DATA").Activate   'Activation Feuille "DATA"

     DerLig_Data = Sheets("DATA").Range("D" & Rows.Count).End(xlUp).Row                 'détermine la dernière ligne
     If DerLig_Data > 8 Then Sheets("DATA").Range("D9:E" & DerLig_Data).ClearContents  'si la dernière ligne est la 8, on fait rien sinon, on efface tout ce qui est en dessous

    ' ******************* LouReeD
    ' on part du principe que la deuxième boucle prend 40% de la barre
    Taille = 60
    Segment_Barre = (Taille / Sheets.Count)

    For I = 1 To Sheets.Count
        If Sheets(I).Name <> "DATA" And Sheets(I).Name <> "ADMINISTRATEUR" Then    'toutes les feuilles sauf "DATA" et "ADMINISTRATEUR"
            PosTiret = InStr(1, Sheets(I).Name, "-", 1) 'relevé de l'emplacement du tiret dans le nom de l'onglet
            Tbl = Left(Sheets(I).Name, PosTiret - 1)
            With Sheets("DATA")    'Choix de la l'onglet "DATA"
                .Cells(9 + I - 3, "D") = Sheets(I).Name 'Nom de l'onglet
                .Cells(9 + I - 3, "G") = Sheets(I).Name 'Nom de l'onglet
                .Range("E" & 9 + I - 3) = "=COUNTIF(" & Tbl & "[CONFORME O / N / PE],""PE"")"  'Data Taleau Statique
                .Range("K" & 9 + I - 3) = "=COUNTIF(" & Tbl & "[CONFORME O / N / PE],""PE"")"  'Data Taleau Dynamique (Pour Datas Courbes Barres)
            End With
        End If

        '****** LouReeD
        Image_barre.Width = Image_barre.Width + Segment_Barre
        Label_barre.Caption = Image_barre.Width * 1.5 & "%"
        DoEvents

    Next I

    DerLig_Data = Worksheets("DATA").Range("D" & Rows.Count).End(xlUp).Row   'détermine la dernière ligne
    If DerLig_Data > 8 Then
        With Sheets("DATA")
            .Range("D9:E" & DerLig_Data).Value = Range("D9:E" & DerLig_Data).Value 'remplacement des formules par leurs valeurs
            .Range("K9:K" & DerLig_Data).Value = Range("K9:K" & DerLig_Data).Value 'remplacement des formules par leurs valeurs

        End With

    End If

' En 3- METTRE A JOURS LA LISTE DES ONGLETS DANS "ADMINISTRATEUR"

    Call MJLIST_Onglet   'Appel module MJLIST_Onglet

     Init_Dossier.Height = 140   'définition hauteur UserForm "Init_Dossier" à la fermeture

    '****** LouReeD
    ' on s'assure que la barre est complète
    Image_barre.Width = 150
    Label_barre.Caption = "100%"

  ' MsgBox "Toutes les feuilles sont mises à jour", vbInformation

' Worksheets("DATA").Visible = False 'Cache la feuille "DATA"

    '****** LouReeD
    ' on efface le USF
    Unload userform_demo

End Sub

Avec suppression de tous les codes du USF d'origine, mais il faut alors le retravailler un peu :
Suppression du bouton, remonter les différents labels qui se trouvent sur le bas (ils sont masqués car la taille global du USF est trop petite, donc l'agrandir vers le bas. Adapter ensuite la taille du USF à ce qui reste.

@ bientôt

LouReeD

LouReeD · Answer

J'ai bon espoir, à la lecture cela me semble correcte. Bons tests @ vous ! @ bientôt LouReeD...

LouReeD · Answer

Le code ne trouve pas l'objet Image_Barre, existe il sur votre USF ? @ bientôt LouReeD...

BsAlv · Answer

Un barre de progression, c'est un idea stupide, je préfères utiliser le "application.statusbar" une fois tout les 50-100 (?) executions. Si vous ajouter "application.Calculation=xlCalculationManual" au début et automatique à la fin, (dépend du fonctionnement du fichier, si cela peut !), est-ce que vous gagner beaucoup de temps ? En diminuent le nombre de interactions avec la feuille, on peut gagner beaucoup de temps. Y-a-t'il des possibilités ? Il s'agit de combien de lignes en moyenne ...

BsAlv · Answer

Y a-t-il une possibilité de créer un fichier avec des données non-confidentielles avec autant de lignes que habituelle.

Le temps d'executer le macro, il est combien pour le moment ?

Je suppose que ce soit possible de le faire en une fraction (la moitié , 1/3 , ... ?)