Discussion :

[facteur]

Bonjour

Je souhaiterais me lancer dans la création d'une barre de progression lors de l'exécution d'une macro.

Je m'explique, tous les jours, j'exécute plusieurs modules à partir d 'un bouton de commande crée sur un des onglets de mon fichier Excel. Et chaque module fait appelle à une procédure stockée sql.
L'exécution de ces modules dure environ 10 minutes ce qui n'est pas choquant vu le nombre de procédure stockée ( environ une vingtaine).
Le souci c'est que j'aimerais voir la progression de l'exécution de mon code.
Je ne sais pas par où commencer
Une petite aide serait le bienvenu

Ci dessous , mon code vba

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
Private Sub bt_MAJ_Click()
 
Application.ScreenUpdating = False
 
ActiveWorkbook.Save 'enrigistrement du fichier
 
 
'.........................................................................................................
'Dans le module 1
Call module1
'.........................................................................................................
'Dans le module 2
Call module2
'..........................................................................................................
'Dans le module 3
Call module3
'.....................................................................................................
'Dans le module 4
Call module4
'............................................................................................
'Dans Module 5
Call module5
'-----------------------------------------------------------------------------
'Dans le module 6
Call module6
'-----------------------------------------------------------------------------
'Dans le module 7
Call module7
 .....
End sub

[Phil333250]

Bonjour,

Une piste

Je me suis amusé dans un classeur où j'ai 12 macros qui s'exécutent à la suite à mettre à la fin de chacune d'elle le code suivant en faisant varier la colonne :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
Sheets("NomFeuille").Select
    Range("H14").Select
 
    With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .Color = 5296274
        .TintAndShade = 0
        .PatternTintAndShade = 0
    End With

Mais bon c'est du "bricolage".

Philippe

[Franc]

Bonjour, voilà, j'ai modifié ta macro et ajouté une macro pour mise à jour de la barre de progression.
J'ai évidemment supprimé application.screenupdating sinon on ne voit pas la barre.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
Private Sub bt_MAJ_Click()
 
    ActiveWorkbook.Save 'enregistrement du fichier
 
    ' Supprimer la barre de progression existante (si elle existe)
    On Error Resume Next
    ActiveSheet.Shapes("ProgressBarShape").Delete
    ActiveSheet.Shapes("ProgressBarLabel").Delete
    On Error GoTo 0
 
    ' Définir la position et les dimensions de la barre de progression
    Dim leftPosition As Double
    Dim topPosition As Double
    Dim widthValue As Double
    Dim heightValue As Double
 
    leftPosition = 10 ' Position horizontale de la barre de progression
    topPosition = 10 ' Position verticale de la barre de progression
    widthValue = 200 ' Largeur de la barre de progression
    heightValue = 20 ' Hauteur de la barre de progression
 
    ' Créer la forme de la barre de progression
    Dim progressBarShape As Shape
    Set progressBarShape = ActiveSheet.Shapes.AddShape(msoShapeRectangle, leftPosition, topPosition, widthValue, heightValue)
    progressBarShape.Name = "ProgressBarShape"
 
    ' Personnaliser l'apparence de la barre de progression
    With progressBarShape
        .Fill.ForeColor.RGB = RGB(0, 128, 0) ' Couleur de remplissage de la barre de progression (vert)
        .Line.Visible = False ' Cacher la bordure de la barre de progression
    End With
 
    ' Ajouter un libellé à la barre de progression
    Dim progressBarLabel As Shape
    Set progressBarLabel = ActiveSheet.Shapes.AddLabel(msoTextOrientationHorizontal, leftPosition, topPosition, widthValue, heightValue)
    progressBarLabel.Name = "ProgressBarLabel"
 
    ' Définir le texte initial du libellé
    progressBarLabel.TextFrame2.TextRange.Text = "0%"
 
    ' Définir le format du texte du libellé
    With progressBarLabel.TextFrame2.TextRange.Font
        .Size = 12 ' Taille de la police
        .Fill.ForeColor.RGB = RGB(255, 255, 255) 'texte blanc
        .Bold = msoTrue ' Gras
    End With
 
    ' Définir le nombre total de modules à exécuter
    Dim totalModules As Integer
    totalModules = 7
 
    ' Exécuter les modules en mettant à jour la barre de progression
    Call Module1
    Call UpdateProgressBar(1, totalModules, progressBarShape, progressBarLabel, widthValue)
    DoEvents
    Call Module2
    Call UpdateProgressBar(2, totalModules, progressBarShape, progressBarLabel, widthValue)
    DoEvents
    Call Module3
    Call UpdateProgressBar(3, totalModules, progressBarShape, progressBarLabel, widthValue)
    DoEvents
    Call Module4
    Call UpdateProgressBar(4, totalModules, progressBarShape, progressBarLabel, widthValue)
    DoEvents
    Call Module5
    Call UpdateProgressBar(5, totalModules, progressBarShape, progressBarLabel, widthValue)
    DoEvents
    Call Module6
    Call UpdateProgressBar(6, totalModules, progressBarShape, progressBarLabel, widthValue)
    DoEvents
    Call Module7
    Call UpdateProgressBar(7, totalModules, progressBarShape, progressBarLabel, widthValue)
    DoEvents
    Application.Wait (Now + TimeValue("0:00:02")) 'juste pour avoir le temps de voir que c'est fini
    ' Supprimer la barre de progression une fois la macro terminée
    progressBarShape.Delete
    progressBarLabel.Delete
 
 
End Sub

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
Private Sub UpdateProgressBar(ByVal currentModule As Integer, ByVal totalModules As Integer, ByVal progressBarShape As Shape, ByVal progressBarLabel As Shape, ByVal widthValue As Double)
    ' Calculer le pourcentage d'avancement
    Dim progressPercentage As Double
    progressPercentage = (currentModule / totalModules) * 100
 
    ' Mettre à jour la largeur de la barre de progression
    progressBarShape.Width = (progressPercentage / 100) * widthValue
 
    ' Mettre à jour le texte du libellé avec le pourcentage
    progressBarLabel.TextFrame2.TextRange.Text = Format(progressPercentage, "0") & "%"
 
    ' Actualiser l'affichage de la barre de progression et du libellé
    DoEvents
End Sub

[facteur]

Bonjour Franc
Merci pour t'être penché sur mon problème.
je vais tester cela aujourd'hui. Et je reviendrais vers toi pour te faire un topo

[facteur]

@Phil333250 , je n'aie pas ton code final

@Franc, heu..ton code ne fonctionne pas; J'ai bien la création de la barre de progression qui se crée mais rien ne s'affiche à l'intérieur lorsque la macro 1 s'éxcute

[Franc]

J'ai testé avant de t'envoyer le code, chez moi ça fonctionne.
Sans voir ton classeur je ne sais pas te dire où est le problème.

[jurassic pork]

Hello

@Franc, heu..ton code ne fonctionne pas; J'ai bien la création de la barre de progression qui se crée mais rien ne s'affiche à l'intérieur lorsque la macro 1 s'éxcute

la macro1 cela correspond au module 1 ? Que fais-tu dedans ? Combien de temps dure-t-elle? Il est certain que rien ne va s'afficher pendant l'exécution du module car la maj de la barre de progression n'a lieu qu'après l'exécution du module.
Ami calmant, J.P

[umfred]

Comme dit par JP, il faut faire l'UpdateProgressBar aux endroits stratégiques de ton code:
si il y a une boucle dans ton code, faire la mise à jour à chaque itération de la boucle par exemple

Et voir aussi si Application.ScreenUpdating ne serait pas à False quelque part (ça peut probablement jouer aussi sur la visibilité de la barre de progression)

[jurassic pork]

Hello,
sinon en utilisant le formulaire ProgressBar de cette discussion on peut obtenir quelque chose comme ceci :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
Sub LancerModules()
    Dim Module()
    Dim x as Integer
    Module() = Array("Module1", "Module2", "Module3", "Module4", "Module5", "Module6", "Module7")
    totalModules = UBound(Module) - LBound(Module) + 1
    ProgressBar.Show False
    For x = LBound(Module) To UBound(Module)
        Debug.Print Module(x)
        ' Exécuter les modules en mettant à jour la barre de progression
        UpdateProgressBar (x / totalModules), Module(x) & " en cours d'exécution ..."         '--- ajuste la barre de progression
        Application.Run Module(x)
    Next x
    UpdateProgressBar 1, " Exécution terminée ! "
    Application.Wait (Now + TimeValue("0:00:05"))
    Unload ProgressBar
End Sub
 
Sub UpdateProgressBar(PctDone As Single, ByVal msg As String)   '--- PctDone = pour cent réalisé
    With ProgressBar
        '--- Mise à jour du label.
        .FrameProgress.Caption = Format(PctDone, "0%")
        '--- Largeur de la barre par rapport à so cadre
        .LabelProgress.Width = (.FrameProgress.Width - 12) * PctDone
        .Label1 = msg
    End With
    '--- DoEvents autorisant au UserForm de ce mettre à  jour
    DoEvents
End Sub
Sub Module1()
 Application.Wait (Now + TimeValue("0:00:05"))
End Sub
Sub Module2()
 Application.Wait (Now + TimeValue("0:00:05"))
End Sub
Private Sub Module3()
 Application.Wait (Now + TimeValue("0:00:05"))
End Sub
Private Sub Module4()
 Application.Wait (Now + TimeValue("0:00:05"))
End Sub
Private Sub Module5()
 Application.Wait (Now + TimeValue("0:00:05"))
End Sub
Private Sub Module6()
 Application.Wait (Now + TimeValue("0:00:05"))
End Sub
Private Sub Module7()
 Application.Wait (Now + TimeValue("0:00:05"))
End Sub

Attention pour que le Application.Run fonctionne il ne faut pas qu'il y ait un module qui ait le même nom qu'une procédure ( ex : Module1 --> renommer le module ModuleProgressBar)
Ami calmant, J.P

[laurent_ott]

en utilisant le formulaire ProgressBar de cette discussion

J'utilise aussi ce formulaire, j'ai juste modifié le code d'appel pour supprimer la croix en haut à droite afin que l'utilisateur ne le ferme pas :

Code VBA :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
Declare PtrSafe Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As LongPtr
#If Win64 Then
Declare PtrSafe Function SetWindowLongPtr Lib "user32" Alias "SetWindowLongPtrA" (ByVal hwnd As LongPtr, ByVal nIndex As Long, ByVal dwNewLong As LongPtr) As LongPtr
Declare PtrSafe Function GetWindowLongPtr Lib "user32" Alias "GetWindowLongPtrA" (ByVal hwnd As LongPtr, ByVal nIndex As Long) As LongPtr
#Else
Declare PtrSafe Function SetWindowLongPtr Lib "user32" Alias "SetWindowLongA" (ByVal hwnd As LongPtr, ByVal nIndex As Long, ByVal dwNewLong As LongPtr) As LongPtr
Declare PtrSafe Function GetWindowLongPtr Lib "user32" Alias "GetWindowLongA" (ByVal hwnd As LongPtr, ByVal nIndex As Long) As LongPtr
#End If
 
Option Explicit
 
Private Sub UserForm_Activate()
    ' Mise à jour du label
    FrameProgress.Caption = Format(0, "0%")
    ' Largeur de la progressBar à 0
    ProgressBar.LabelProgress.Width = 0
    ' Masque la croix du formulaire:
    Dim hwnd As LongPtr
    hwnd = FindWindow("ThunderDFrame", Me.Caption)
    SetWindowLongPtr hwnd, -16, GetWindowLongPtr(hwnd, -16) And &HFFF7FFFF
End Sub

[facteur]

@jurassic pork

la macro1 cela correspond au module 1 ? Que fais-tu dedans ? Combien de temps dure-t-elle? Il est certain que rien ne va s'afficher pendant l'exécution du module car la maj de la barre de progression n'a lieu qu'après l'exécution du module.

La macro 1 correspond bien au module 1.
Dans ce moule 1, j'exécute un code VBA qui m'affiche le résultat d'une requête sql server ( ci dessous)
ce code dure environ 1 minute

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
Sub macro1()
 
Dim cn As ADODB.Connection
  Dim cm As ADODB.Command
  Dim rs As ADODB.Recordset
  Dim sql As String
  Dim GenereCSTRING As String
  Dim i As Integer
  Dim Feuille As Worksheet
 
 
 
Set Feuille = Worksheets("Feuill1")
 
Set cn = New ADODB.Connection
 
 sql = "[Customer].dbo.Requete1" ' je nomme ma procédure stockée
 
 GenereCSTRING = "Provider=SQLOLEDB.1;Password=" & "nomserveur" & ";Persist Security Info=True;User ID=" & "exploitation" & ";Initial Catalog=" & "Archive" & ";Data Source=" & "adresseIP" & " " '* SQLServer2008R2
 cn.Open GenereCSTRING 'J'ouvre ma connection.
 
'------------------------------------------------------------------------------------------------------------------------------------------------------
  Set cm = New ADODB.Command
 
  With cm
    .ActiveConnection = cn
    .CommandText = sql
    .CommandTimeout = 0 
    .CommandType = adCmdStoredProc 
    .Parameters.Append .CreateParameter("P1", adDate, adParamInput, 4, Sheets("onglet1").Range("B16")) 
    .Parameters.Append .CreateParameter("P2", adDate, adParamInput, 4, Sheets("onglet1").Range("C16")) 
  End With
 
  Set rs = cm.Execute()
 
  With ThisWorkbook.Sheets("Feuil1")
     For i = 0 To rs.Fields.Count - 1 
               .Range("B3").Offset(0, i) = rs(i).Name
     Next
        .Range("B4").CopyFromRecordset rs 
End With
 
End Sub

[umfred]

Tu peux afficher un état de la barre de progression avant et après, pas pendant l'attente du résultat de la requête (c'est celle-ci qui doit prendre le plus de temps, car la requête (ligne 34) est "bloquante".

Je ne sais pas si en rajoutant un Timer, on pourrait faire avancer la barre pendant l'attente de la requête

[facteur]

@Franc
Je sais ou est le soucis
Lorsque je lande le code voici ce qui apparait sur ma feuille Excel


lorsque je glisse ce rectange en dessous voila ce qui apparait


Et lorsque j'execute la premiere macro, voila ce que j'ai

C'est ce rectangle qui cachait la barre de progression

Donc tout fonctionne. Il faut que le remplissage de ce rectange soit vide pour que apparaisse la barre de progression. C'est pourquoi j'ai rajouter la ligne de code 5

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
' Ajouter un libellé à la barre de progression
    Dim progressBarLabel As Shape
    Set progressBarLabel = ActiveSheet.Shapes.AddLabel(msoTextOrientationHorizontal, leftPosition, topPosition, widthValue, heightValue)
    progressBarLabel.Name = "ProgressBarLabel"
    progressBarLabel.Fill.Visible = msoFalse

Cependant, pourquoi la barre de progression est remplie dés le début (en vert) lorsque je lance mon code VBA. Ne serait il pas judicieux qu'elle soit vide et que dés que la première macro s'exécute, on voit la barre de progression demarrer

[Franc]

Je n'ai pas d'explication, le test chez moi affiche une portion de barre avec le pourcentage et ainsi de suite jusqu'à 100%, et je n'ai pas non plus cette fenêtre à déplacer pour voir la barre
Tu as fait des modifications au code que j'ai fourni ?
Voici le fichier test que j'ai utilisé et qui affiche la barre de progression correctement.

progressbar.xlsm

[umfred]

ça ressemble à un problème d'ordre d'empilement (paramètre ZOrder ou via clic droit "premier plan"/"arrière plan")

[facteur]

@Franc ton code fonctionne trés bien et je t'en remercie.
J'aurais deux question à te poser :
Pourquoi tu a rajouté la ligne de code suivant

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

 Application.Wait (Now + TimeValue("0:00:03"))

comment sais tu d'avance la largeur qu'aura la barre de progression:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

  widthValue = 200 ' Largeur de la barre de progression

@umfred lorsque j'exécute le code, cela n'pas d'impact sur l'exécution du code. Donc je laisse comme cà

[Franc]

Salut,
Cette ligne Application.Wait (Now + TimeValue("0:00:03")) c'est juste pour te laisser le temps de voir que la barre est à 100%, tu peux la supprimer.
Concernant la largeur de la barre, j'ai décidé arbitrairement, si tu la veux plus longue ou plus courte, à toi de décider, idem pour la position.

[facteur]

@Franc merci pour ces infos.
J'ai encore une question à te poser
Si j'ai qu'une seule macro dans mon fichier Excel, ton code n'est plus approprié à ce cas de figure car dans ton code, la progression se fait par rapport au nombre de module.
Comment pourrais je alors calculer le temps d'exécution de ma macro non plus par rapprot au nombre de module car j'en aie qu'un mais par rapport au temps qu'il faut pour exécuter ce module.

[Franc]

Tu veux afficher une barre de progression pour une macro ou tu veux simplement savoir le temps d'exécution ?
Dans le premier cas ça me semble un peu compliqué à mettre en oeuvre, dans le second cas je peux te fournir un chrono que j'utilise personnellement pour optimiser mes macros.

[jurassic pork]

Hello,

Si j'ai qu'une seule macro dans mon fichier Excel, ton code n'est plus approprié à ce cas de figure car dans ton code, la progression se fait par rapport au nombre de module.
Comment pourrais je alors calculer le temps d'exécution de ma macro non plus par rapprot au nombre de module car j'en aie qu'un mais par rapport au temps qu'il faut pour exécuter ce module.

une possibilité :
Lancer la requête sql en asynchrone (pour ne pas bloquer le VBA) et lancer dans la foulée un timer (windows API) qui met à jour un formulaire qui affiche une barre de progression qui s'incrémente en utilisant le temps moyen d'exécution de la requête comme limite. On arrête le timer si on atteint la limite ou si la requête est terminée. On fait disparaître le formulaire si la requête est terminée (réception de l'événement ExecuteComplete dans le VBA).
Voici ce que cela donne en utilisant Ado.Connection sur une base de donnée PostgreSQL en utilisant un driver ODBC. La requête est une requête de sélection d'une table avec un "gel" de 10 secondes en utilisant la fonction SQL postgreSQL pg_sleep(10) :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

strSQL = "Select * from employees, pg_sleep(10);"

Ami calmant, J.P