Barre de progression

S

sdevers

XLDnaute Nouveau
Bonjour la communauté,
[SUB]
Pour ceux qui se demanderaient, j'ai reclassé ma question d'un commentaire sur le forum "Applications disponibles dans l'espace de téléchargement" vers ce nouveau post sur le forum principal.[/SUB]

J'avais trouvé un bel exemple de barre de progression sur un autre site (Créer une barre de progression avec Excel). Malheureusement, je ne parviens pas à l'adapter à mes besoins.

Voici le code de base de l'exemple:
Code: 
Private Sub CommandButton1_Click()
   
    'Macro : Sébastien Mathier - Excel-Pratique
    'Tuto vidéo : http://www.blog-excel.com/barre-de-progression-excel/
   
    Application.ScreenUpdating = False
   
    UserForm_demo.Height = 121.5

    compteur = 0
    progression = 0
   
    For ligne = 1 To 5000
        For col = 1 To 50
       
            compteur = compteur + 1
            Cells(ligne, col) = ligne + col
           
            If compteur Mod 2500 = 0 Then '=> sera exécuté 100x
               
                progression = progression + 1
                Image_barre.Width = progression * 1.5
                Label_barre.Caption = progression & "%"
                DoEvents
               
            End If
           
        Next
    Next
   
    Application.ScreenUpdating = True
    UserForm_demo.Height = 136.5
   
End Sub
Il utilise donc un compteur avec un Mod 2500 car il a 50.000 occurrences à sa boucle (par facilité son exemple ajoute un chiffre dans 50.000 cellules). Il incrémente donc de 0,5% à chaque fois qu'il arrive à un résultat de 0 avec son Mod 2500. Ca fonctionne extrêmement bien... mais pas pour mon code ! En effet, je n'ai pas 50.000 occurrences mais un nombre indéterminé.

Dans mon code, je veux (notamment car j'adapterai ma progress bar à d'autres procédures également) ajouter un pied-de-page personnalisé sur chaque page du classeur. Le nombre de page ne dépend pas de moi. Il pourrait y en avoir 2 ou 3 comme 30. J'ai donc un Sheet.Count comme limite maximale qui est une variable.

Code: 
Private Sub CommandButton1_Click()
   
    'Macro : Sébastien Mathier - Excel-Pratique
    'Tuto vidéo : http://www.blog-excel.com/barre-de-progression-excel/
   
    Application.ScreenUpdating = False
   
    UserForm_demo.Height = 121.5

    compteur = 0
    progression = 0
    Dim X As Byte
   
    For X = 1 To Sheets.Count
       
        With Sheets(X).PageSetup
            compteur = compteur + 1
            .LeftFooter = "test" 'je simplifie mon footer pour le forum
           
            If compteur Mod Sheets.Count = 0 Then
               
                progression = progression + 1
                Image_barre.Width = progression * 1 / Sheets.Count
                Label_barre.Caption = progression & "%"
                DoEvents
               
            End If

Problème, dans ce code, la barre de progression reste calée à 0 même quand la procédure est terminée. Je n'arrive pas à définir à quelle vitesse ma barre de progression doit avancer (là où il y avait le Mod 2500 chez l'auteur). Il me faudrait une variable...

Quelqu'un de plus futé que moi pourrait m'aider?

Merci d'avance,
 
Trier par date Trier par votes
Modeste geedee

Modeste geedee

XLDnaute Barbatruc
Re : Barre de progression

Bonsour®

Il manque quelques informations ... :rolleyes:

quelle est la largeur max (i.e pour 100%)


Dim X As integer
Dim SCount as integer
Scount= Sheets.count
For X = 1 To SCount

With Sheets(X).PageSetup
.LeftFooter = "test" 'je simplifie mon footer pour le forum
'--------------
' l'affichage correspond alors au pourcentage de feuilles traitées relativament au nombre de feuilles total
Image_Barre.Width = Image_MaxBarre_Width * X / SCount
Label_barre.Caption = format(X/Scount, "0%")
DoEvents
End With
Next
 
Dernière édition:
Vote positif 0 Vote négatif
S

sdevers

XLDnaute Nouveau
Re : Barre de progression

Merci modeste geedee.

Si j'ai bien compris, il te manque la largeur maximum de Image_barre, c'est bien ça? C'est pour cette raison que tu as ajouté Image_MaxBarre.

Dans l'exemple que j'avais récupéré, il n'y a pas Image_MaxBarre. Il avait créé un second compteur "progression" qui comptait le nombre de fois où Mod 2500 =0 (soit les %). Ensuite, Image_Barre s'élargissait à chaque avancement de 1%. Il multiplait son résultat par 1,5 car la largeur de sa barre était de 150 (et non pas 100).

Est-ce plus clair?
 
Vote positif 0 Vote négatif
S

sdevers

XLDnaute Nouveau
Re : Barre de progression

C'est cool, ça fonctionne ! Mais j'ai un autre (petit) soucis.

Voici mon code:
Code: 
Private Sub set_footer()
    '------------------------------------------------
    'on désactive certains paramètres pour accélérer la macro. On les réactive en fin de macro.
    '------------------------------------------------
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationAutomatic 'on a besoin de laisser le mode automatique
    '------------------------------------------------
    UserForm_demo.Height = 121.5
    UserForm_demo.Show
    
    compteur = 0
    Dim X As Integer
    Dim SCount As Integer
    SCount = Sheets.Count
    '------------------------------------------------
    'Inscription d'un pied de page identique sur chaque page
    '------------------------------------------------
    For X = 1 To SCount

        With Sheets(X).PageSetup
            'pied de page gauche - écriture en Calibri, taille 9, couleur &K63666A (R99-G102-B106) -
            'venant chercher l'information dans la cellule D2 de la Sheet "data" (nom VBA: Sheet03)
            'puis retour à la ligne (Chr(10))
            'puis écriture en Calibri, taille 9, couleur &K63666A (R99-G102-B106) -
            'venant chercher l'information dans les cellules C13 et D8 de la Sheet "data" (nom VBA: Sheet03) (avec un espace entre les 2 textes)
            .LeftFooter = "&""Calibri""" & "&9&K63666A" & Sheet03.Range("D2") _
                & Chr(10) & "&""Calibri""" & "&9&K63666A" & Sheet03.Range("Company_Number_txt") & " " & Sheet03.Range("D8")
            
            'pied de page droite - écriture en Calibri, taille 9, couleur &K63666A (R99-G102-B106) -
            'venant chercher l'information dans les cellules C14 et C9 de la Sheet "data" (nom VBA: Sheet03)(avec un espace entre les 2 textes)
            'puis retour à la ligne (Chr(10))
            'puis écriture en Calibri, taille 9, couleur &K63666A (R99-G102-B106) -
            'venant chercher l'information dans les cellules C15 et C10 de la Sheet "data" (nom VBA: Sheet03) (avec un espace entre les 2 textes)
            .RightFooter = "&""Calibri""" & "&9&K63666A" & Sheet03.Range("Tax_Year_txt") & " " & Sheet03.Range("C9") _
                & Chr(10) & "&""Calibri""" & "&9&K63666A" & Sheet03.Range("Closing_Date_txt") & " " & Sheet03.Range("C11")
                
            Image_barre.Width = 150 * X / SCount
            Label_barre.Caption = Format(X / SCount, "0%")
            DoEvents
            
        End With
    Next X
    '------------------------------------------------


    '------------------------------------------------
    'on réactive les paramètres qu'on avait désactivé au début de la procédure
    '------------------------------------------------
    Application.ScreenUpdating = True
    Application.Calculation = xlCalculationAutomatic
    '------------------------------------------------
    UserForm_demo.Height = 136.5
    Unload UserForm_demo
    
    
End Sub

Par rapport à la version précédente, j'ai juste fait en sorte que la progress bar se lance au moment de ma procédure (et pas au moyen d'un bouton à cliquer).

Mon problème, j'ai un message de débogage (error 424 objet requis) qui bloque sur "Image_barre.Width = 150 * X / SCount" quand je ferme le userform au moyen de la croix.

Si tu as une idée lumineuse ;)
 
Vote positif 0 Vote négatif
S

sdevers

XLDnaute Nouveau
Re : Barre de progression

Modeste geedee à dit:
Bonsour®

l'idée lumineuse serait de fournir l'exemple ... !!!
à tout hasard ...

Code: 
...
Me.Image_barre.Width = 150 * X / SCount
Me.Label_barre.Caption = Format(X / SCount, "0%")
Me.Repaint
...
DoEvents
Cliquez pour agrandir...

Voici ma pièce jointe. Ca se trouve dans Module_Footer et dans UserForm_demo...
 

Pièces jointes

  • Annexes comptables & fiscales v20160131 - test EXCEL DOWNLOADS.xlsm
    177.3 KB · Affichages: 153
Dernière modification par un modérateur:
Vote positif 0 Vote négatif

Discussions similaires

H
  • Question
XL 2013 Barre de progression Userrform utilisée sur plusieurs macros
Réponses
0
Affichages
466
hemerode
H
G
  • Question
Google Sheets Barre de progression google sheet
Réponses
0
Affichages
239
Gregous
G
B
  • Résolu(e)
XL 2013 Barre de progression.
Réponses
7
Affichages
413
fanfan38
fanfan38
A
  • Question
Microsoft 365 Barre de progression
Réponses
5
Affichages
622
ADS95
A
jeandechanel
  • Résolu(e)
Barre de progression
Réponses
7
Affichages
968
jeandechanel
jeandechanel
Dudu2
VBA - Barre de progression sur la base d'un UserForm
Réponses
2
Affichages
691
Bat1504
B
D
  • Question
XL 2013 Incrémentation de numéros d'anonymat pour des candidats à un examen plus barre de progression
Réponses
8
Affichages
1 K
AtTheOne
AtTheOne
D
  • Question
XL 2013 Barre de progression qui fonctionne pas
Réponses
2
Affichages
720
degards
D
D
  • Question
XL 2010 VBA - Barre de progression
2
Réponses
16
Affichages
3 K
Dranreb
Dranreb
A
  • Résolu(e)
XL 2019 Fichier = Fichier + barre de progression
Réponses
3
Affichages
942
Arnaud59000
A

Membres actuellement en ligne

17 membres et 182 invités.

Partager cette page

Tutos vidéos

Power Query : Ajouter des requêtes (Excel et Power BI)
Créez votre première fonction LAMBDA dans Excel en 3 étapes!
LAMBDA, l’arme secrète de Microsoft pour Excel !
Office Insider - Découvrez les nouveautés Excel avant tout le monde

Statistiques des forums

Discussions
312 286
Messages
2 086 795
Membres
103 392
dernier inscrit
doc_banane