Amélioration code barre progression

Question

Je me suis approprié le code du fichier ci joint (merci à son créateur dont j'ai bien entendu laissé les références et les remarques dans les commentaires du code) au sens ou j'ai essayé de l'adapter à mon besoin. Ce code a pour objectif de faire patienter l'utilisateur en affichant une barre de progression en pourcentage au sein d'un userform lors de l'exécution d'une macro longue en temps de traitement, il est multi plateforme Mac et Windows. 2 Questions : Quelles seraient vos remarque pour encore améliorer et optimiser ce code ? Plus sur sa conception et sa rapidité que la partie "look" ou graphique (même si je suis preneur de toutes remarques) Comment adapter ce code, pour une macro sans boucles mais dont les étapes successives serait des call vers plusieurs sous macros ? J'imagine qu'il faudrait adapter la partie suivante du code de la Private Sub TestTheBar() du USERFORM ? J'ai essayé mais je n'ai pas réussi à le faire, faire en sorte que chaque call incrémmente un compteur. 'Initilaizing Variables lngNumberOfTasks = 100 'Calling the ShowProgress sub with ActionNumber = 0, to let the 'user know we are going to work on the 1st task. Call modProgress.ShowProgress(0, lngNumberOfTasks, _ , False) For lngCounter = 1 To lngNumberOfTasks 'The code for each task goes here '&lt;your code here&gt; 'Call the ShowProgress sub each time a task is finished to 'the user know that X out of Y tasks are over, and that 'the X+1'th task is in progress. Call modProgress.ShowProgress(lngCounter, lngNumberOfTasks, _ , False) Next lngCounter Merci Cordialement Hugues...

Steelson · Accepted Answer

Reste à adapter .....

Steelson · Answer

Suggestion = indique en dessous de la barre les différentes étapes en cours correspondant aux différents call que tu fais...

Squalleh · Answer

Idée qui vaut ce qu'elle vaut, si on part du principe que tous les "Call" sont de même durée, tu peux créer une variable que tu incrémentes à chaque appel et que tu divises par le nombre d'appel le tout multiplié par 100 pour avoir un "%age" de réalisation. Sq'...

Theze · Answer

Voici un code que j'ai créé et différent de celui que tu as posté ! Deux Labels sont utilisés mais pas sur un UserForm, directement sur la feuille nommée "Feuil1". Trois procédures sont appelées l'une après l'autre et donc, la barre de progression va avancer par tranche de 30% Supprime ces procédures et remplace par les tiennes. Incrémente l'argument "PosAppel" par rapport à la procédure appelée (ici, de 1 à 3) et bien sûr, la variable Max doit aussi être adaptée (ici aussi, 3) Dans un premier temps, colle le code dans un module standard, pose un bouton "Formulaire" et attache lui la procédure "ProgressBar" : Sub ProgressBar() Dim Fe As Worksheet Dim Ctrl As OLEObject Dim LblProgress As MSForms.Label Dim LblFond As MSForms.Label Dim LargeurLabel As Integer Dim HauteurLabel As Integer Dim Max As Long Dim R As Single Dim I As Long Dim J As Long Set Fe = Worksheets("Feuil1") 'défini les dimensions LargeurLabel = 500 HauteurLabel = 20 With Fe Application.ScreenUpdating = False 'suppression des labels parasites ! On Error Resume Next .OLEObjects("LblProgress").Delete .OLEObjects("LblFond").Delete On Error GoTo 0 'crée le label servant de fond Set Ctrl = .OLEObjects.Add("Forms.Label.1") 'passe l'objet à la variable afin d'utiliser les propriétés des labels Set LblFond = Ctrl.Object 'défini certaines de ces dernières With LblFond .Name = "LblFond" .Caption = "" .BackColor = &amp;HC0FFFF .BorderStyle = fmBorderStyleSingle .Left = Application.UsableWidth / 2 - LargeurLabel / 2 .Top = Application.UsableHeight / 2 .Width = LargeurLabel .Height = HauteurLabel End With 'crée le label servant de barre de progression Set Ctrl = .OLEObjects.Add("Forms.Label.1") 'idem que plus haut Set LblProgress = Ctrl.Object With LblProgress .Name = "LblProgress" .Caption = "" .BorderStyle = fmBorderStyleSingle .BackColor = &amp;H800000 .ForeColor = &amp;HFFFFFF .Left = Application.UsableWidth / 2 - LargeurLabel / 2 .Top = Application.UsableHeight / 2 .Width = 0 .Height = HauteurLabel .TextAlign = fmTextAlignCenter End With Application.ScreenUpdating = True 'ici, commence la progression de la barre avec des appels successifs de procédures... '################################################ Max = 3 '&lt;-- pour le test, nombre de procédures appelées... 'rapport R = LargeurLabel / Max GestionProgress LblProgress, Max, R, "Macro1", 1 GestionProgress LblProgress, Max, R, "Macro2", 2 GestionProgress LblProgress, Max, R, "Macro3", 3 ' GestionProgress LblProgress, Max, R, "Macro4", 4 ' GestionProgress LblProgress, Max, R, "Macro5", 5 '################################################ 'suppression des labels On Error Resume Next .OLEObjects("LblProgress").Delete .OLEObjects("LblFond").Delete End With End Sub Sub GestionProgress(LblProgress As MSForms.Label, MaxVal As Long, R As Single, Proc As String, PosAppel As Integer) Application.Run Proc LblProgress.Width = PosAppel * R DoEvents LblProgress.Caption = Format(PosAppel / MaxVal, "#0%") End Sub 'PROCEDURES A SUPPRIMER ET A REMPLACER PAR LES TIENNES Sub Macro1() Dim I As Long Dim ValeurMax As Long ValeurMax = 100000 'boucle pour perdre du temps... For I = 1 To ValeurMax DoEvents Next I End Sub Sub Macro2() Dim I As Long Dim ValeurMax As Long ValeurMax = 100000 'boucle pour perdre du temps... For I = 1 To ValeurMax DoEvents Next I End Sub Sub Macro3() Dim I As Long Dim ValeurMax As Long ValeurMax = 100000 'boucle pour perdre du temps... For I = 1 To ValeurMax DoEvents Next I End Sub...

Theze · Answer

Voici un classeur avec l'utilisation d'un UserForm ...

Steelson · Answer

De rien, merci pour ton retour et tes conseils d'aménagement...