Utiliser la barre d'état pour suivre la progression d'une procédure

Sommaire

  • intérêt
  • solution
  • utilisation
  • La procédure qui écrit dans la barre d'état
  • Utilisation (insertion du code dans une procédure)
  • Performances
  • Utilisation d'un userform
  • Utilisation d'un module de classe nouveau

Intérêt

Certaines procédures utilisent des boucles For Next pour répéter des instructions. Dans ce cas le temps peut paraître long à l'utilisateur, et il est bon de lui donner des informations sur l'état d'avancement du travail ainsi que le temps restant à attendre.

Solution

Pour cela au lieu de faire un travail avec un dessin dans un formulaire, je propose d'utiliser une fonction texte pour pouvoir utiliser la barre d'état pour afficher des informations sur l'exécution en cours. Le résultat ci dessous est composé

  • d'un texte que vous choisissez ici : patientez
  • d'une barre de progression composée de signes + pour la partie écoulée et de signes - pour ce qu'il reste à faire
  • d'une indication sur le temps restant estimé en minutes et secondes.

La barre d'état

l'écriture dans la barre d'état se fait comme suit :

  • Application.StatusBar = "texte à afficher"
  • Puis quand on veut rendre à Excel l'affichage normal :
  • Application.StatusBar = False

Un autre intérêt de la barre d'état est qu'elle reste active même quand l'écran est figé. En effet, pour qu'une procédure soit plus rapide, en général on préfère ne pas rafraîchir l'écran. On utilise pour cela l'instruction :

  • Application.ScreenUpdating = False
  • Pendant la boucle, puis on pense bien à remettre
  • Application.ScreenUpdating = True
  • après la boucle.

Ceci a pour effet de montrer un écran figé pendant que la procédure travaille.

La barre de progression

Elle se fait avec la fonction stxt (mid en vba)
vous pouvez utiliser cette manière de faire dans une feuille :

la formule utilisée ici est :

  • =SI(A1=0;"□□□□□□□□□□";STXT("■■■■■■■■■■□□□□□□□□□□□";MAX(ARRONDI(11-A1*10;0);1);10))

Avec en A1 un chiffre entre 0 et 100% chaque carré représentant 10%. Vous pouvez utiliser d'autres caractères à la place des carrés choisis ici, mais veillez toujours à faire un essai d'impression.

Utilisation d'une fonction personnalisée.

au lieu de saisir toute cette formule on peut utiliser une fonction personnalisée ce qui permettra de saisir simplement dans la cellule

  • =prog_char(A1)

Cette fonction contient 3 paramètres

  • pct obligatoire : le taux de réalisation actuel compris entre 0 et 100%
    • comme un pourcentage non compris entre 0 et 1 va provoquer une erreur, j'utilise une fonction qui recadre la valeur entre 0 et 1
    • par défaut elle travaille entre 0 et 1, mais on peut changer les bornes
    • Function minimaxi(x As Single, Optional maxi As Single = 1, Optional mini As Single = 0)
      'borne x entre les valeurs mini et maxi utilisé ici pour rester entre 0 et 1
      minimaxi = IIf(x > mini, IIf(x > maxi, maxi, x), mini)
      End Function
    • on voit que la fonction iif est utilisée, elle resemble à la fonction si de la feuille de calcul.
  • t_vide optionnel : le caractère utilisé pour représenter une case vide
  • t_plein optionnel : le caractère utilisé pour représenter une case pleine

Ceci permet d'afficher d'autres caractères que ceux du départ. Pour avoir les carrés le programme contient chrw qui peut poser un problème sur mac (les codes > à 127 ne sont pas gérés sur mac).

Function prog_char(pourcentage As Single, Optional t_vide As String = "ù", Optional t_plein As String = "ù", Optional longueur As Integer = 10) As String
'crée une barre de progression composée de carrés représentant 10% si longueur reste à 10
Dim pct As Single
pct = minimaxi(pourcentage) 'met le pourcentage entre 0 et 100%
'longueur entre 4 et 100
longueur = IIf(longueur > 4, IIf(longueur > 100, 100, longueur), 4)
If t_vide = "ù" Then t_vide = ChrW(9633) 'carré vide
If t_plein = "ù" Then t_plein = ChrW(9632) 'carré plein
If pct < 1 / longueur Then 'affichage d'une barre vide
prog_char = String(longueur, t_vide)
Else
prog_char = Mid(String(longueur, t_plein) + String(longueur, t_vide), Round(longueur + 1 - pct * longueur, 0), longueur)
End If
End Function

Le calcul du temps restant

Le temps restant estimé est calculé en fonction du pourcentage de boucles réalisée et donc du pourcentage de boucles restant à faire. Ce temps est exprimé en secondes. Ce paramètre est basé sur la date de départ (t_départ) qui doit contenir le résultat de la fonction Timer. Cette fonction donne le nombre de secondes écoulées depuit minuit avec une grande précision. Si t_départ = 0 la fonction renvoie "" ce qui est attendu si on n'a pas mis le paramètre à la fonction appelante.

Function restant(t_départ As Single, taux As Single, Optional lib_temps As String = "temps restant estimé") As String
'renvoie un texte indiquant le temps restant
Dim pct As Single, mn As Single, t_restant As Single
restant = ""
pct = minimaxi(taux) 'utile pour ne pas changer la variable taux et met le pourcentage entre 0 et 100%
If t_départ <> 0 And pct <> 0 Then
'texte pour le temps restant
restant = lib_temps + " "
'calcul du temps restant en fonction du nombre de boucles
t_restant = (Timer - t_départ) / pct * (1 - pct)
mn = Int(t_restant / 60) 'calcul du nombre de minutes
If mn > 0 Then
t_restant = t_restant - mn * 60 'secondes
restant = restant + FormatNumber(mn, 0) + " mn "
End If
restant = restant + FormatNumber(t_restant, 1) + " s"
End If
End Function

La procédure qui écrit dans la barre d'état

La version 1 de la procédure qui est appelée à chaque boucle

Sub progression(texte_à_afficher As String, pct As Single, Optional t_départ As Single = 0)
'réalisé par Sylvain code commenté sur
'http://sn1.chez-alice.fr/presentation/progression.htm
Dim pc1 As Single
pc1 = minimaxi(pct) 'met le pourcentage entre 0 et 100%
If pc1 >= 1 Then
'100% on rend la barre classique
Application.StatusBar = False
Else
'gestion de l'affichage du temps
Application.StatusBar = texte_à_afficher + " " + prog_char(pc1) + " " + restant(t_départ, pc1)
End If
End Sub

Utilisation

Exemple d'utilisation de cette procédure dans un code :

top_départ=Timer
for indice=1 to 160
Call progression("patientez", indice/160, top_départ)
[instructions...]
next

Utilisation de la procédure sans affichage du temps :

for indice=1 to 160
Call progression("patientez", indice/160)
[instructions...]
next

Attention si votre boucle contient une intruction Exit Sub ou Exit For, pensez à la faire précéder d'une ligne

  • Application.StatusBar = False
  • et si vous l'avez utilisé pensez aussi à remettre
  • Application.ScreenUpdating = True

Performances :

Combien de temps prend l'exécution de ce code, j'ai donc fait un essai avec une boucle ne faisant qu'afficher les informations sur mon PC à 400mhz. Pour une boucle de 10000 cyles le temps de calcul est de 7 secondes (5 secondes si on n'affiche pas le temps restant).Cela fait moins d'une seconde pour informer votre utilisateur pour une boucle de mille tours.

Pour éviter le clignotement qui peut être désagréable et gagner du temps, on peut décider de n'afficher les informations uniquement tous les 1%. Pour cela on va utiliser une variable pcti qui contient le dernier taux quand on a lancé la procédure.

top_départ=Timer
pcti=0

for indice=1 to 160

if indice=160 or indice/160> pcti + 0.01 then
pcti=indice/160
Call progression("patientez", pcti, top_départ)
end if

[instructions...]
next

Bien que cela soit valable, les ordinateurs n'ayant pas tous la même rapidité une autre méthode a été choisie. En travaillant comme ci dessus, l'effet de clignotement aurait continué sur un ordinateur rapide. Le choix s'est donc porté sur un rafraîchissement périodique de l'affichage. La procédure se dote donc de deux paramètres supplémentaires (en fait trois : la taille en nombre de caractères de la barre est maintenant modifiable) :

  • délai_entre_maj : contient en secondes le temps entre 2 rafraîchissements (valeur comprise entre 1/10s et 10s)
  • dernière_maj : variable qui devra être initialisée avec le timer avant le lancement de la boucle

Sub progression(texte_à_afficher As String, pourcentage As Single, Optional t_départ As Single = 0, Optional dernière_maj As Single = 0, Optional délai_entre_maj As Single = 0, Optional nbcar_barre As Integer = 10)
'écriture d'une barre de progression dans la barre d'état
'http://sn1.chez-alice.fr/presentation/progression.htm
Dim pc1 As Single
pc1 = minimaxi(pourcentage) 'met le pourcentage entre 0 et 100%
If pc1 >= 1 Then
'100% on rend la barre classique
Application.StatusBar = False
Else
If dernière_maj > 0 And délai_entre_maj > 0 Then 'si on ne veut mettre à jour la barre que périodiquement
délai_entre_maj = minimaxi(délai_entre_maj, 10, 0.1) 'le délai de mise à jour doit être compris entre 1/10 et 10 secondes
If Timer > dernière_maj + délai_entre_maj Then
dernière_maj = Timer 'mise à jour de l'instant de mise à jour
Else
Exit Sub 'pas d'affichage à cette boucle
End If
End If
'gestion de l'affichage du temps
Application.StatusBar = texte_à_afficher + " " _
+ prog_char(pc1, , , nbcar_barre) + " " + _
restant(t_départ, pc1)
End If
End Sub

Utilisation d'un userform

Exemple si la procédure contenant la boucle est lancée à partir de l'userform comme ici en appuyant sur le bouton lancer la procédure. Au départ on ne voit que l'userform avec uniquement le bouton (les libellés par défaut (caption) sont vides (on peut aussi imaginer que la hauteur du userform ne soit pas entière avant le lancement de la procédure ou l'utilisation d'un userform multifeuilles).

La procédure de mise à jour du userform est donc simplement :

Sub u_progress(pct As Single, Optional libellé As String = "", Optional départ As Single = 0)
Dim pc1 As Single
pc1 = minimaxi(pct) 'remet entre 0 et 100%
With u_progression
.b_p = prog_char(pc1) 'affiche la barre de progression
.lib_affiché = restant(départ, pc1, "reste environ") 'affiche le temps restant
.Repaint
End With
End Sub

Où u_progression est le nom du userform, b_p est le nom de l'étiquette contenant la barre de progression et lib_affiché est le nom de l'étiquette contenant le temps restant. Repaint redessine le userform à chaque fois.

La version avec mise à jour périodique et longueur de la barre personnalisable est celle-ci :

Sub u_progress(pct As Single, Optional libellé As String = "", _
Optional départ As Single = 0, Optional dernière_maj As Single = 0, _
Optional délai_entre_maj As Single = 0, Optional nbcar_barre As Integer = 20)
'gestion de la mise à jour du formulaire
Dim pc1 As Single
pc1 = minimaxi(pct) 'remet entre 0 et 100%
If pc1 <> 1 Then 'on affiche toujours 100%
If dernière_maj > 0 And délai_entre_maj > 0 Then 'utilisation de la possibilité de ne pas mettre à jour à chaque fois
délai_entre_maj = minimaxi(délai_entre_maj, 10, 0.1) 'fréquence de mise à jour entre 1/10 et 10s
If Timer > dernière_maj + délai_entre_maj Then
dernière_maj = Timer 'enregistrement du moment de la mise à jour
Else
Exit Sub 'pas de mise à jour du formulaire cette fois
End If
End If
End If
With u_progression 'nom du formulair
.b_p = prog_char(pc1, , , nbcar_barre) 'affiche la barre de progression
.lib_affiché = restant(départ, pc1, "reste environ") 'affiche le temps restant
.Repaint 'met à jour le formulaire avec les nouvelles informations
End With
End Sub

Classeur à télécharger

Classeur avec les procédures vues et des exemples de caractères à utiliser avec leurs codes étendus.

Utilisation d'un module de classe

L'utilisation de procédures dans un module normal peut rendre le projet moins lisible quand il comprend beaucoup de modules qui font des choses différentes. D'autre part, l'utilisation des procédures ci dessus demandent beaucoup de variables. L'utilisation d'un module de classe permet de créer un nouvel objet "barre de progression" ce qui va avoir comme avantages :

  • De ranger le code de manière simple à retrouver
  • D'avoir les noms des procédures de manière simple

Un module de classe s'ajoute dans VBE en passant par exemple par le menu insertion on le nomme Barre_de_progression. Il va contenir tout le code relatif au type d'objet que nous créons ainsi que les procédures des évènements associés.

L'entête avec déclaration des variables Option Explicit
Dim Carre_blanc As String, Carre_noir As String, _
  Longueur As Integer, Depart_timer As Double, Derniere_mise_a_jour As Double, _
  Temps_entre_mise_a_jour_1_10 As Double
Les objets créés via modules de classe ont 2 évènements, Initialise et terminate, ici l'initialisation des variables Private Sub Class_Initialize()
  'paramètres par défaut de la barre de progression
  Carre_blanc = ChrW(9633)
  Carre_noir = ChrW(9632)
  Longueur = 20
  Temps_entre_mise_a_jour_1_10 = 1
End Sub
Les valeurs par défaut peuvent ne pas convenir on peut alors utiliser la procédure change_paramètres pour les changer. Comme on peut ne pas vouloir changer toutes les valeurs, elles sont mises optionnelles et on utilise ismissing pour tester la demande de mise à jour. Is missing nécessitant d'utiliser des variables de type variant on va vérifier si la valeur passée est du type correspondant à ce qui est nécessaire pour le paramètre concerné. Sub Change_parametres(Optional ByVal Caractere_blanc, _
  Optional ByVal Caractere_noir, Optional Longueur_barre_progression, _
  Optional Temps_entre_mise_a_jour_en_dixiemes)
  'test ismissing pour ne changer les valeurs que si on a demandé de les changer
  'comme ismissing ne marche que pour des variants, _
  on doit vérifier le type d'informations passées

  If Not IsMissing(Caractere_blanc) Then
    If TypeName(Caractere_blanc) = "String" Then
      Carre_blanc = Mid(Caractere_blanc & ChrW(9633), 1, 1)
    End If
  End If
  If Not IsMissing(Caractere_noir) Then
    If TypeName(Caractere_noir) = "String" Then
       Carre_noir = Mid(Caractere_noir & ChrW(9632), 1, 1)
    End If
  End If
  If Not IsMissing(Longueur_barre_progression) Then
    If IsNumeric(Longueur_barre_progression) Then
      Longueur = Int(Borne_entre_minimaxi(Longueur_barre_progression, 100, 4))
    End If
  End If
  If Not IsMissing(Temps_entre_mise_a_jour_en_dixiemes) Then
    If IsNumeric(Temps_entre_mise_a_jour_en_dixiemes) Then
      Temps_entre_mise_a_jour_1_10 = Int(Borne_entre_minimaxi(Temps_entre_mise_a_jour_en_dixiemes, 600, 0))
    End If
  End If
End Sub
Comme dans la version ci dessus, on a besoin de fonctions pour encadrer des valeurs entre 2 bornes Private Function Borne_entre_minimaxi(ByVal x As Double, Optional ByVal maxi As Double = 1, Optional ByVal mini As Double = 0)
    'borne x entre les valeurs mini et maxi utilisé par exemple pour rester entre 0 et 100%
    Dim Swape
    If mini > maxi Then 'vérification mini < maxi
      Swape = mini
      mini = maxi
      maxi = Swape
    End If
    If x < mini Then
      Borne_entre_minimaxi = mini
    ElseIf x > maxi Then
      Borne_entre_minimaxi = maxi
    Else
      Borne_entre_minimaxi = x
    End If
End Function
Au lieu ou en plus de la barre de progression, on peut vouloir indiquer le temps restant estimé. Cette fonction renvoie l'estimation de temps restant en minutes et secondes. Function Indication_temps_restant(ByVal Pourcentage_Effectue As Double) As String
  'renvoie un texte indiquant le temps restant
    Dim Nombre_de_minutes As Double, Temps_restant As Double
    
    'initialisation au premier tour
    If Depart_timer = 0 Then Depart_timer = Timer
    
    Pourcentage_Effectue = Borne_entre_minimaxi(Pourcentage_Effectue) 'met le pourcentage entre 0 et 100%
    If Pourcentage_Effectue = 0 Then
      Indication_temps_restant = " "
      Exit Function
    ElseIf Pourcentage_Effectue = 1 Then
      Call Me.Reinitialise_timer
      Exit Function
    End If
    
    'timer démarre à minuit, afin de ne pas être trop faux si on a lancé la procédure avant on va tester ça
    Dim Temps_passe
    Temps_passe = Timer - Depart_timer
    If Temps_passe < 0 Then
      On Error Resume Next
      Temps_passe = Temps_passe + (24 * 3600)
      If Err.Number <> 0 Then Temps_passe = 0
      On Error GoTo 0
    End If
    If Temps_passe <= 0 Then
      Indication_temps_restant = " "
      Exit Function
    End If
    
    'calcul du temps restant en fonction du nombre de boucles
    Temps_restant = (Temps_passe) / Pourcentage_Effectue * (1 - Pourcentage_Effectue)
    Nombre_de_minutes = Int(Temps_restant / 60)
    If Nombre_de_minutes > 0 Then
      Temps_restant = Temps_restant - Nombre_de_minutes * 60 'secondes
      Indication_temps_restant = Indication_temps_restant + FormatNumber(Nombre_de_minutes, 0) + " mn "
    End If
    Indication_temps_restant = Indication_temps_restant + FormatNumber(Temps_restant, 1) + " s"
End Function
La fonction qui crée la barre de progression, ici on utilise string soit l'équivallent de rept pour faire la barre de progression. Function Barre_de_progression(ByVal Pourcentage_Effectue As Double)
  'fait la barre simple
  Dim Longueur_effectuee
  If Depart_timer = 0 Then Depart_timer = Timer  'initialisation au premier tour

  'réinitialisation à 100%
  If Pourcentage_Effectue = 1 Then
      Call Me.Reinitialise_timer
      Exit Function
  End If
  
  'crée une barre de progression composée de carrés représentant 5% si longueur reste à 20
  Pourcentage_Effectue = Borne_entre_minimaxi(Pourcentage_Effectue)  'met le pourcentage entre 0 et 100%
  If Pourcentage_Effectue < 1 / Longueur Then  'affichage d'une barre vide
    Barre_de_progression = String(Longueur, Carre_blanc)
  Else
    Longueur_effectuee = Round(Pourcentage_Effectue * Longueur, 0)
    Barre_de_progression = String(Longueur_effectuee, Carre_noir) & String(Longueur - Longueur_effectuee, Carre_blanc)
  End If
End Function
On voit dans les 2 procédures précédentes qu'arrivé à 100% on réinitialise le timer pour une éventuelle réutilisation de la procédure

'réinitialisation à 100%
If Pourcentage_Effectue = 1 Then
Call Me.Reinitialise_timer
Exit Function
End If

Si on sort de la boucle par exit for, et qu'on veut réutiliser la variable barre de progression, il faudra nous même lancer cette procédure

Sub Reinitialise_timer()
  'remet le timer à 0 à utiliser seulement _
  dans le cas où on sort de la boucle avant la fin (exit for) et qu'on doit _
  refaire une barre de progression dans la même procédure _
  sinon Depart_timer se remet à 0 dès qu'on atteint 100%
  Depart_timer = 0
  Application.StatusBar = False
End Sub
Function Barre_de_progression(ByVal Pourcentage_Effectue As Double)
Pour éviter les clignottements on utilise un test pour vérifier que l'affichage se fait tout les 1/10ème de secondes (valeur modifiable) Function Delai_entre_mise_a_jour_ok() As Boolean
  'renvoie vrai tous les Temps_entre_mise_a_jour_1_10
  'pour éviter les clignotements
  If Timer > Derniere_mise_a_jour + Temps_entre_mise_a_jour_1_10 / 10 Then
    Derniere_mise_a_jour = Timer
    Delai_entre_mise_a_jour_ok = True
  Else
    Delai_entre_mise_a_jour_ok = False
  End If
End Function
L'autre évènement d'un objet personnel est terminate. Ici on utilise cet évènement pour effacer la barre d'état si on a fait exit for sans lancer reinitialise timer Private Sub Class_Terminate()
  'se lance quand on efface l'objet via set bp=nothing par exemple ou à la fin de la procédure
  'utile si par exemple on est sorti via un exit for _
  et qu'on a oublié d'effacer la barre de progression de la barre d'état

  Application.StatusBar = False
End Sub

Un module de classe crée un nouveau type d'objet que nous pouvons affecter à une variable ici bp pour barre de progression

Maintenant on a accès aux différentes propriétés et méthodes facilement par l'assistance de l'éditeur VBE :

Exemple de code utilisant l'objet en affichant l'information dans la barre d'état puis dans un formulaire U_progress ayant 2 labels : a_duree et a_barre

Option Explicit

Sub Test_barre_de_progression_dans_barre_d_etat()

Cette procédure est dans un module normal
Dim bp As New Barre_progression
Dim i As Long, n As Long 'variables de boucle
n = 16000 'nb de boucles
Déclarations des variables n est initialisé à 16000, mais si votre ordinateur est plus ou moins performant, vous pouvez changer cette valeur.

bp.Change_parametres Temps_entre_mise_a_jour_en_dixiemes:=2

utilisation de la fonction change_parametres pour changer l'intervalle de rafraîchissement par rapport à la valeur par défaut qui est 1. On aurait pu écrire simplement :

bp.Change_parametres , , , 2

Thisworkbook.activate

Cells.Clear

For i = 1 To n

Cells(i).Value = "Bonjour"

If i = 10000 Then Exit For

Le programme consiste simplement à mettre "bonjour" dans les cellules, on commence par effacer ce qu'il y a (attention à ne pas lancer ce programme si votre classeur n'est pas au premier plan d'où le thisworkbook.activate pour être sûr).

Ici pour la première simulation on imagine qu'on sort avant la fin (attention, si vous mettez moins de 10000 dans n cela ne va pas marcher sauf à changer cette ligne).

If bp.Delai_entre_mise_a_jour_ok = True Then _
Application.StatusBar = bp.Barre_de_progression(i / n) & " Reste : " & bp.Indication_temps_restant(i / n)
Next

Delai_entre_mise_a_jour_ok vérifie qu'il y a bien eu 2 dixièmes de secondes (valeur choisie précédemment) depuis la dernière demande.

Si oui on met dans la barre d'état quelque chose qui va ressembler à :

bp.Reinitialise_timer

Cells.Clear

Load U_progress

U_progress.Show False

On recommencera l'opération, mais comme on est sorti via exit for, on réinitialise le timer

On charge en mémoire le formulaire et on l'affiche en mode non modal avec le false après show.

Application.ScreenUpdating = False

For i = 1 To n

Cells(i).Value = "Bonjour"

L'intérêt des barres de progression est la possibilité d'utiliser application.screenupdating= false car comme ça fait un écran figé, la barre de progression indique quand même qu'il se passe quelque chose.

If bp.Delai_entre_mise_a_jour_ok = True Then

U_progress.a_barre.Caption = bp.Barre_de_progression(i / n)

U_progress.a_duree.Caption = "Temps restant estimé " & bp.Indication_temps_restant(i / n)

U_progress.Repaint

Comme à la première boucle, on teste à chaque tour s'il y a eu le temps nécessaire entre 2 affichages
Le formulaire a 2 étiquettes (label) a_barre et a_duree.

On les modifie en fonction du moment et on utilise Repaint pour actualiser le formulaire aux dernières valeurs

Application.StatusBar = bp.Barre_de_progression(i / n) & " Reste : " & bp.Indication_temps_restant(i / n)

End If

On fait également un affichage dans la barre de progression

Next

Unload U_progress

End Sub

On décharge le formulaire de la mémoire, même si la boucle ne s'était pas terminé, la fin de la procédure entraîne le déchargement de la mémoire de l'objet bp et donc l'instruction

application.statusbar=false associée à l'évènement terminate.

Télécharger le classeur avec le module de classe ici

Contact

Retenez mes coordonnées pour tout projet du plus modeste au plus évolué.



Accueil excel
les liens excel
Les classeurs à télécharger

références et coordonnées

page d'accueil
CD de formation
cd polykromy