Barre de progression dans VBA Excel
Je fais une application Excel qui nécessite beaucoup de données mises à jour à partir d'une base de données, donc cela prend du temps. Je veux faire une barre de progression dans un userform et elle apparaît lorsque les données sont mises à jour. La barre que je veux, c’est juste une petite barre bleue qui se déplace à droite et à gauche et se répète jusqu’à ce que la mise à jour soit terminée, aucun pourcentage n’est nécessaire… .. Je sais que je devrais utiliser le contrôle progressbar, mais j’ai essayé pendant un certain temps mais je ne peux pas le faire.
EDIT: Mon problème est avec le contrôle progressbar, je ne peux pas voir la barre «progrès», il suffit de compléter lorsque le formulaire apparaît. J'utilise une boucle et DoEvent mais cela ne fonctionne pas. De plus, je veux que le processus se répète, pas seulement une fois.
Dans le passé, avec les projets VBA, j'avais utilisé un contrôle d'étiquette avec l'arrière-plan coloré et ajusté la taille en fonction de la progression. Vous trouverez des exemples d'approches similaires dans les liens suivants:
- http://oreilly.com/pub/h/2607
- http://www.ehow.com/how_7764247_create-progress-bar-vba.html
- http://spreadsheetpage.com/index.php/tip/displaying_a_progress_indicator/
En voici une qui utilise les formes automatiques d'Excel:
Parfois, un simple message dans la barre d'état suffit:
C'est très simple à mettre en œuvre :
Dim x As Integer
Dim MyTimer As Double
'Change this loop as needed.
For x = 1 To 50
' Do stuff
Application.StatusBar = "Progress: " & x & " of 50: " & Format(x / 50, "0%")
Next x
Application.StatusBar = False
Voici un autre exemple d'utilisation de la barre d'état en tant que barre de progression.
En utilisant des caractères Unicode, vous pouvez imiter une barre de progression. 9608 - 9615 sont les codes que j'ai essayés pour les barres. Il suffit d’en sélectionner un en fonction de l’espace que vous souhaitez afficher entre les barres. Vous pouvez définir la longueur de la barre en modifiant NUM_BARS. De même, en utilisant une classe, vous pouvez la configurer pour gérer l’initialisation et la libération automatique de StatusBar. Une fois que l'objet est hors de portée, il nettoie automatiquement et relâche le StatusBar dans Excel.
' Class Module - ProgressBar
Option Explicit
Private statusBarState As Boolean
Private enableEventsState As Boolean
Private screenUpdatingState As Boolean
Private Const NUM_BARS As Integer = 50
Private Const MAX_LENGTH As Integer = 255
Private BAR_CHAR As String
Private SPACE_CHAR As String
Private Sub Class_Initialize()
' Save the state of the variables to change
statusBarState = Application.DisplayStatusBar
enableEventsState = Application.EnableEvents
screenUpdatingState = Application.ScreenUpdating
' set the progress bar chars (should be equal size)
BAR_CHAR = ChrW(9608)
SPACE_CHAR = ChrW(9620)
' Set the desired state
Application.DisplayStatusBar = True
Application.ScreenUpdating = False
Application.EnableEvents = False
End Sub
Private Sub Class_Terminate()
' Restore settings
Application.DisplayStatusBar = statusBarState
Application.ScreenUpdating = screenUpdatingState
Application.EnableEvents = enableEventsState
Application.StatusBar = False
End Sub
Public Sub Update(ByVal Value As Long, _
Optional ByVal MaxValue As Long= 0, _
Optional ByVal Status As String = "", _
Optional ByVal DisplayPercent As Boolean = True)
' Value : 0 to 100 (if no max is set)
' Value : >=0 (if max is set)
' MaxValue : >= 0
' Status : optional message to display for user
' DisplayPercent : Display the percent complete after the status bar
' <Status> <Progress Bar> <Percent Complete>
' Validate entries
If Value < 0 Or MaxValue < 0 Or (Value > 100 And MaxValue = 0) Then Exit Sub
' If the maximum is set then adjust value to be in the range 0 to 100
If MaxValue > 0 Then Value = WorksheetFunction.RoundUp((Value * 100) / MaxValue, 0)
' Message to set the status bar to
Dim display As String
display = Status & " "
' Set bars
display = display & String(Int(Value / (100 / NUM_BARS)), BAR_CHAR)
' set spaces
display = display & String(NUM_BARS - Int(Value / (100 / NUM_BARS)), SPACE_CHAR)
' Closing character to show end of the bar
display = display & BAR_CHAR
If DisplayPercent = True Then display = display & " (" & Value & "%) "
' chop off to the maximum length if necessary
If Len(display) > MAX_LENGTH Then display = Right(display, MAX_LENGTH)
Application.StatusBar = display
End Sub
Exemple d'utilisation:
Dim progressBar As New ProgressBar
For i = 1 To 100
Call progressBar.Update(i, 100, "My Message Here", True)
Application.Wait (Now + TimeValue("0:00:01"))
Next
============== This code goes in Module1 ============
Sub ShowProgress()
UserForm1.Show
End Sub
============== Module1 Code Block End =============
Créer un bouton sur une feuille de calcul; bouton de la carte à la macro "ShowProgress"
Créez un UserForm1 avec 2 boutons, barre de progression, zone de barre, zone de texte:
UserForm1 = canvas to hold other 5 elements
CommandButton2 = Run Progress Bar Code; Caption:Run
CommandButton1 = Close UserForm1; Caption:Close
Bar1 (label) = Progress bar graphic; BackColor:Blue
BarBox (label) = Empty box to frame Progress Bar; BackColor:White
Counter (label) = Display the integers used to drive the progress bar
======== Attach the following code to UserForm1 =========
Option Explicit
' This is used to create a delay to prevent memory overflow
' remove after software testing is complete
Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
Private Sub UserForm_Initialize()
Bar1.Tag = Bar1.Width
Bar1.Width = 0
End Sub
Sub ProgressBarDemo()
Dim intIndex As Integer
Dim sngPercent As Single
Dim intMax As Integer
'==============================================
'====== Bar Length Calculation Start ==========
'-----------------------------------------------'
' This section is where you can use your own '
' variables to increase bar length. '
' Set intMax to your total number of passes '
' to match bar length to code progress. '
' This sample code automatically runs 1 to 100 '
'-----------------------------------------------'
intMax = 100
For intIndex = 1 To intMax
sngPercent = intIndex / intMax
Bar1.Width = Int(Bar1.Tag * sngPercent)
Counter.Caption = intIndex
'======= Bar Length Calculation End ===========
'==============================================
DoEvents
'------------------------
' Your production code would go here and cycle
' back to pass through the bar length calculation
' increasing the bar length on each pass.
'------------------------
'this is a delay to keep the loop from overrunning memory
'remove after testing is complete
Sleep 10
Next
End Sub
Private Sub CommandButton1_Click() 'CLOSE button
Unload Me
End Sub
Private Sub CommandButton2_Click() 'RUN button
ProgressBarDemo
End Sub
================= UserForm1 Code Block End =====================
============== This code goes in Module1 =============
Sub ShowProgress()
UserForm1.Show
End Sub
============== Module1 Code Block End =============
Le contrôle de l'étiquette qui redimensionne est une solution rapide. Cependant, la plupart des gens finissent par créer des formulaires individuels pour chacune de leurs macros. J'ai utilisé la fonction DoEvents et un formulaire non modal pour utiliser un seul formulaire pour toutes vos macros.
Voici un article de blog que j'ai écrit à ce sujet: http://strugglingtoexcel.wordpress.com/2014/03/27/progress-bar-Excel-vba/
Tout ce que vous avez à faire est d'importer le formulaire et un module dans vos projets et d'appeler la barre de progression avec: Appelez modProgress.ShowProgress (ActionIndex, TotalActions, Title .....)
J'espère que ça aide.
J'aime toutes les solutions publiées ici, mais j'ai résolu ce problème en utilisant la mise en forme conditionnelle sous forme de barre de données basée sur des pourcentages.
Ceci est appliqué à une rangée de cellules comme indiqué ci-dessous. Les cellules qui incluent 0% et 100% sont normalement masquées, car elles sont simplement là pour donner le contexte de plage nommée "ScanProgress" (gauche).
Dans le code, je parcours une table en faisant des trucs.
For intRow = 1 To shData.Range("tblData").Rows.Count
shData.Range("ScanProgress").Value = intRow / shData.Range("tblData").Rows.Count
DoEvents
' Other processing
Next intRow
Code minimal, a l'air décent.
Salut version modifiée d'un autre poste de Marecki . A 4 styles
1. dots ....
2 10 to 1 count down
3. progress bar (default)
4. just percentage.
Avant de demander pourquoi je n’ai pas modifié ce message, c’est ce que j’ai fait et il a été rejeté.
Sub ShowProgress()
Const x As Long = 150000
Dim i&, PB$
For i = 1 To x
DoEvents
UpdateProgress i, x
Next i
Application.StatusBar = ""
End Sub 'ShowProgress
Sub UpdateProgress(icurr As Long, imax As Long, Optional istyle As Integer = 3)
Dim PB$
PB = Format(icurr / imax, "00 %")
If istyle = 1 Then ' text dots >>.... <<'
Application.StatusBar = "Progress: " & PB & " >>" & String(Val(PB), Chr(183)) & String(100 - Val(PB), Chr(32)) & "<<"
ElseIf istyle = 2 Then ' 10 to 1 count down (eight balls style)
Application.StatusBar = "Progress: " & PB & " " & ChrW$(10111 - Val(PB) / 11)
ElseIf istyle = 3 Then ' solid progres bar (default)
Application.StatusBar = "Progress: " & PB & " " & String(100 - Val(PB), ChrW$(9608))
Else ' just 00 %
Application.StatusBar = "Progress: " & PB
End If
End Sub
Sub ShowProgress()
' Author : Marecki
Const x As Long = 150000
Dim i&, PB$
For i = 1 To x
PB = Format(i / x, "00 %")
Application.StatusBar = "Progress: " & PB & " >>" & String(Val(PB), Chr(183)) & String(100 - Val(PB), Chr(32)) & "<<"
Application.StatusBar = "Progress: " & PB & " " & ChrW$(10111 - Val(PB) / 11)
Application.StatusBar = "Progress: " & PB & " " & String(100 - Val(PB), ChrW$(9608))
Next i
Application.StatusBar = ""
End SubShowProgress
À propos du contrôle progressbar dans un userform, il ne fera aucun progrès si vous n'utilisez pas l'événement repaint. Vous devez coder cet événement dans la boucle (et évidemment incrémenter la valeur progressbar).
Exemple d'utilisation:
userFormName.repaint
La solution publiée par @eykanal n'est peut-être pas la meilleure solution si vous avez une énorme quantité de données à traiter, car l'activation de la barre d'état ralentirait l'exécution du code.
Le lien suivant explique une bonne manière de construire une barre de progression. Fonctionne bien avec un volume de données élevé (~ 250K enregistrements +):
http://www.Excel-easy.com/vba/examples/progress-indicator.html
Dialogue sympa forme de barre de progression que je cherchais . barre de progression de alainbryden
très simple à utiliser, et a l'air bien.
Le lien edit: ne fonctionne que pour les membres premium:: /
ici est la classe alternative de Nice.
J'ai aimé la barre d'état de cette page:
https://wellsr.com/vba/2017/Excel/vba-application-statusbar-to-mark-progress/
Je l'ai mis à jour pour qu'il puisse être utilisé comme procédure appelée. Aucun crédit pour moi.
showStatus Current, Total, " Process Running: "
Private Sub showStatus(Current As Integer, lastrow As Integer, Topic As String)
Dim NumberOfBars As Integer
Dim pctDone As Integer
NumberOfBars = 50
'Application.StatusBar = "[" & Space(NumberOfBars) & "]"
' Display and update Status Bar
CurrentStatus = Int((Current / lastrow) * NumberOfBars)
pctDone = Round(CurrentStatus / NumberOfBars * 100, 0)
Application.StatusBar = Topic & " [" & String(CurrentStatus, "|") & _
Space(NumberOfBars - CurrentStatus) & "]" & _
" " & pctDone & "% Complete"
' Clear the Status Bar when you're done
' If Current = Total Then Application.StatusBar = ""
End Sub
Il y a eu beaucoup d'autres bons articles, mais j'aimerais dire qu'en théorie, vous devriez pouvoir créer un contrôle de barre de progression REAL:
- Utilisez
CreateWindowEx()pour créer la barre de progression
Un exemple C++:
hwndPB = CreateWindowEx(0, PROGRESS_CLASS, (LPTSTR) NULL, WS_CHILD | WS_VISIBLE, rcClient.left,rcClient.bottom - cyVScroll,rcClient.right, cyVScroll,hwndParent, (HMENU) 0, g_hinst, NULL);
hwndParent Doit être défini sur la fenêtre parente. Pour cela, vous pouvez utiliser la barre d'état ou un formulaire personnalisé! Voici la structure de fenêtre d'Excel trouvée à partir de Spy ++:
Cela devrait donc être relativement simple avec la fonction FindWindowEx().
hwndParent = FindWindowEx(Application.hwnd,,"MsoCommandBar","Status Bar")
Une fois la barre de progression créée, vous devez utiliser SendMessage() pour interagir avec la barre de progression:
Function MAKELPARAM(ByVal loWord As Integer, ByVal hiWord As Integer)
Dim lparam As Long
MAKELPARAM = loWord Or (&H10000 * hiWord)
End Function
SendMessage(hwndPB, PBM_SETRANGE, 0, MAKELPARAM(0, 100))
SendMessage(hwndPB, PBM_SETSTEP, 1, 0)
For i = 1 to 100
SendMessage(hwndPB, PBM_STEPIT, 0, 0)
Next
DestroyWindow(hwndPB)
Je ne sais pas si cette solution est pratique, mais elle pourrait sembler un peu plus officielle que les autres méthodes décrites ici.
Je viens d'ajouter ma part à la collection ci-dessus.
Si vous recherchez moins de code et peut-être une interface utilisateur cool. Consultez mon GitHub pour Progressbar pour VBA 
un personnalisable:
La Dll est conçue pour MS-Access mais devrait fonctionner sur toutes les plateformes VBA avec des modifications mineures. Il existe également un fichier Excel avec des exemples. Vous êtes libre d'étendre les wrappers vba à vos besoins.
Ce projet est actuellement en développement et toutes les erreurs ne sont pas couvertes. Alors attendez-en!
Vous devriez vous inquiéter au sujet des dll tierces et, le cas échéant, n'hésitez pas à utiliser un antivirus en ligne de confiance avant de mettre en oeuvre la dll.