Barra di avanzamento in VBA Excel

Sto facendo un’app Excel che ha bisogno di molti dati di aggiornamento da un database, quindi ci vuole tempo. Voglio fare una barra di avanzamento in un userform e si apre quando i dati si stanno aggiornando. La barra che voglio è solo una piccola barra blu che si muove a destra ea sinistra e si ripete fino al completamento dell’aggiornamento, nessuna percentuale necessaria. So che dovrei usare il controllo progressbar , ma ci ho provato per un po ‘ma non ce la faccio.

EDIT: Il mio problema è con il controllo progressbar , non posso vedere la barra ‘progresso’, si completa solo quando si apre il modulo. Io uso un ciclo e DoEvent ma non funziona. Inoltre, voglio ripetere il processo, non solo una volta.

In passato, con i progetti VBA, ho utilizzato un controllo etichetta con lo sfondo colorato e regolare le dimensioni in base all’avanzamento. Alcuni esempi con approcci simili possono essere trovati nei seguenti link:

  1. http://oreilly.com/pub/h/2607
  2. http://www.ehow.com/how_7764247_create-progress-bar-vba.html
  3. http://spreadsheetpage.com/index.php/tip/displaying_a_progress_indicator/

Ecco uno che utilizza le forms di Excel:

http://www.andypope.info/vba/pmeter.htm

A volte un semplice messaggio nella barra di stato è sufficiente:

Messaggio nella barra di stato di Excel tramite VBA

Questo è molto semplice da implementare :

 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 

Ecco un altro esempio che utilizza StatusBar come barra di avanzamento.

Usando alcuni caratteri Unicode, puoi imitare una barra di avanzamento. 9608 – 9615 sono i codici che ho provato per le barre. Basta selezionarne uno in base alla quantità di spazio che si desidera mostrare tra le barre. Puoi impostare la lunghezza della barra modificando NUM_BARS. Inoltre, utilizzando una class, è ansible configurarla per gestire l’inizializzazione e il rilascio automatico di StatusBar. Una volta che l’object esce dal campo di applicazione, si ripulirà automaticamente e rilascerà StatusBar su 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 '    ' 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 

Esempio di utilizzo:

 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 ============= 

Creare un pulsante su un foglio di lavoro; map button alla macro “ShowProgress”

Creare un UserForm1 con 2 pulsanti, barra di avanzamento, barra, casella di testo:

 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 ============= 

Il controllo dell’etichetta che si ridimensiona è una soluzione rapida. Tuttavia, la maggior parte delle persone finisce per creare moduli individuali per ciascuna delle loro macro. Ho usato la funzione DoEvents e un modulo non modale per utilizzare un unico modulo per tutte le tue macro.

Ecco un post sul blog che ho scritto a riguardo: http://strugglingtoexcel.wordpress.com/2014/03/27/progress-bar-excel-vba/

Tutto quello che devi fare è importare il modulo e un modulo nei tuoi progetti e chiamare la barra di avanzamento con: Call modProgress.ShowProgress (ActionIndex, TotalActions, Title …..)

Spero che aiuti.

Sto amando tutte le soluzioni pubblicate qui, ma l’ho risolto utilizzando la formattazione condizionale come barra dati basata sulla percentuale.

Formattazione condizionale

Questo è applicato a una fila di celle come mostrato di seguito. Le celle che includono 0% e 100% sono normalmente nascoste, perché sono lì solo per dare il contesto di intervallo denominato “LeftProgress” (Left).

Scansione dei progressi

Nel codice sto facendo il giro di un tavolo facendo del roba.

 For intRow = 1 To shData.Range("tblData").Rows.Count shData.Range("ScanProgress").Value = intRow / shData.Range("tblData").Rows.Count DoEvents ' Other processing Next intRow 

Codice minimo, sembra decente.

 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 

Ciao versione modificata di un altro post di Marecki . Ha 4 stili

 1. dots .... 2 10 to 1 count down 3. progress bar (default) 4. just percentage. 

Prima di chiederti perché non ho modificato quel post, l’ho fatto e mi è stato rifiutato di inviare una nuova risposta.

 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 

Informazioni sul controllo barra di progressbar in un modulo utente, non mostrerà alcun progresso se non si utilizza l’evento repaint . Devi codificare questo evento all’interno del ciclo (e ovviamente incrementare il valore della barra di progressbar ).

Esempio di utilizzo:

 userFormName.repaint 

Bella finestra di dialogo che ho cercato. progressbar da alainbryden

molto semplice da usare e bello.

modifica: link funziona solo per i membri premium ora: /

ecco una bella class alternativa.

La soluzione postata da @eykanal potrebbe non essere la migliore se hai una quantità enorme di dati da gestire mentre l’abilitazione della barra di stato rallenterebbe l’esecuzione del codice.

Il seguente link spiega un buon modo per build una barra di avanzamento. Funziona bene con un volume di dati elevato (~ 250K record +):

http://www.excel-easy.com/vba/examples/progress-indicator.html

Ci sono stati molti altri fantastici post, tuttavia vorrei dire che teoricamente dovresti essere in grado di creare un vero controllo della barra di avanzamento:

  1. Utilizzare CreateWindowEx() per creare la barra di avanzamento

Un esempio in 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 Dovrebbe essere impostato sulla finestra genitore. Per quello si potrebbe usare la barra di stato, o un modulo personalizzato! Ecco la struttura della finestra di Excel trovata da Spy ++:

inserisci la descrizione dell'immagine qui

Questo dovrebbe quindi essere relativamente semplice usando la funzione FindWindowEx() .

 hwndParent = FindWindowEx(Application.hwnd,,"MsoCommandBar","Status Bar") 

Dopo aver creato la barra di avanzamento, è necessario utilizzare SendMessage() per interagire con la barra di avanzamento:

 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) 

Non sono sicuro di quanto sia pratica questa soluzione, ma potrebbe sembrare un po ‘più “ufficiale” rispetto ad altri metodi indicati qui.

Aggiungendo la mia parte alla raccolta di cui sopra.

Se stai cercando meno codice e forse un’interfaccia utente interessante. Controlla il mio GitHub per Progressbar per VBA inserisci la descrizione dell'immagine qui

uno personalizzabile:

inserisci la descrizione dell'immagine qui

La Dll è pensata per MS-Access, ma dovrebbe funzionare su tutte le piattaforms VBA con piccole modifiche. C’è anche un file Excel con campioni. Sei libero di espandere i wrapper vba in base alle tue esigenze.

Questo progetto è attualmente in fase di sviluppo e non tutti gli errori sono coperti. Quindi aspettati un po ‘!

Dovresti essere preoccupato per le DLL di terze parti e se lo sei, non esitare a utilizzare qualsiasi antivirus online affidabile prima di implementare la DLL.