Fortschrittsbalken in VBA Excel

Manchmal genügt eine einfache Meldung in der Statusleiste:

Dies ist sehr einfach zu implementieren :

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

Hier ist ein weiteres Beispiel, in dem die Statusleiste als Fortschrittsleiste verwendet wird. 

Durch die Verwendung einiger Unicode-Zeichen können Sie einen Fortschrittsbalken nachahmen. 9608 - 9615 sind die Codes, die ich für die Bars ausprobiert habe. Wählen Sie einfach eine davon aus, wie viel Platz Sie zwischen den Balken anzeigen möchten. Sie können die Länge der Leiste einstellen, indem Sie NUM_BARS ändern. Wenn Sie eine Klasse verwenden, können Sie sie auch so einrichten, dass die Statusleiste automatisch initialisiert und freigegeben wird. Sobald das Objekt den Gültigkeitsbereich verlässt, wird es automatisch bereinigt und die Statusleiste wieder in Excel freigegeben. 

' 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

Verwendungsbeispiel:

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

Erstellen Sie eine Schaltfläche in einem Arbeitsblatt. Zuordnungsschaltfläche zum Makro "ShowProgress"

Erstellen Sie ein UserForm1 mit 2 Schaltflächen, Fortschrittsleiste, Balkenfeld und Textfeld:

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

Das Etikettensteuerelement, dessen Größe geändert wird, ist eine schnelle Lösung. Die meisten Benutzer erstellen jedoch individuelle Formulare für jedes ihrer Makros. Ich habe die DoEvents-Funktion und ein modellloses Formular verwendet, um ein einziges Formular für alle Ihre Makros zu verwenden. 

Hier ist ein Blogpost, den ich darüber geschrieben habe: http://strugglingtoexcel.wordpress.com/2014/03/27/progress-bar-Excel-vba/

Sie müssen lediglich das Formular und ein Modul in Ihre Projekte importieren und die Fortschrittsleiste aufrufen mit: Aufruf von modProgress.ShowProgress (ActionIndex, TotalActions, Title .....)

Ich hoffe das hilft.

Ich liebe alle hier veröffentlichten Lösungen, aber ich habe dies mit der bedingten Formatierung als prozentuale Datenleiste gelöst.

Dies wird auf eine Reihe von Zellen angewendet, wie unten gezeigt. Die Zellen, die 0% und 100% enthalten, werden normalerweise ausgeblendet, da sie nur den Kontext "ScanProgress" (links) angeben.

Im Code durchlaufe ich eine Tabelle, um etwas zu erledigen.

For intRow = 1 To shData.Range("tblData").Rows.Count

    shData.Range("ScanProgress").Value = intRow / shData.Range("tblData").Rows.Count
    DoEvents

    ' Other processing

Next intRow

Minimaler Code, sieht ordentlich aus.

Hallo modifizierte Version eines anderen Beitrags von Marecki . Hat 4 Arten

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

Bevor Sie fragen, warum ich diesen Beitrag nicht bearbeitet habe, habe ich dies getan und es wurde abgelehnt, eine neue Antwort zu posten.

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

Das progressbar-Steuerelement in einem Benutzerformular zeigt keinen Fortschritt an, wenn Sie das repaint-Ereignis nicht verwenden. Sie müssen dieses Ereignis innerhalb der Schleife codieren (und offensichtlich den Wert für progressbar erhöhen).

Anwendungsbeispiel:

userFormName.repaint

Die von @eykanal gepostete Lösung ist möglicherweise nicht die beste, wenn Sie eine riesige Datenmenge verarbeiten müssen, da die Aktivierung der Statusleiste die Ausführung des Codes verlangsamen würde. 

Der folgende Link erklärt eine nette Möglichkeit, eine Fortschrittsleiste zu erstellen. Funktioniert gut mit hohem Datenvolumen (~ 250.000 Datensätze +): 

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

Schönes Dialog-Fortschrittsbalken-Formular, das ich gesucht habe. progressbar von alainbryden

sehr einfach zu bedienen und sieht gut aus.

edit: link funktioniert jetzt nur für premium mitglieder: /

hier ist eine nette alternative Klasse.

Die Statusleiste auf dieser Seite hat mir gefallen:

https://wellsr.com/vba/2017/Excel/vba-application-statusbar-to-mark-progress/

Ich habe es aktualisiert, damit es als aufgerufene Prozedur verwendet werden kann. Keine Ehre für mich.

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

Es gab viele andere großartige Beiträge, aber ich möchte sagen, dass Sie theoretisch in der Lage sein sollten, ein REAL Fortschrittsbalken-Steuerelement zu erstellen:

1. Verwenden Sie CreateWindowEx(), um die Fortschrittsleiste zu erstellen

Ein C++ - Beispiel:

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 Sollte auf das übergeordnete Fenster gesetzt werden. Dafür könnte man die Statusleiste oder ein benutzerdefiniertes Formular verwenden! Hier ist die Fensterstruktur von Excel aus Spy ++:

Dies sollte daher mit der Funktion FindWindowEx() relativ einfach sein.

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

Nachdem die Fortschrittsleiste erstellt wurde, müssen Sie SendMessage() verwenden, um mit der Fortschrittsleiste zu interagieren:

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)

Ich bin nicht sicher, wie praktisch diese Lösung ist, aber sie könnte etwas "offizieller" sein als die anderen hier genannten Methoden.

Fügen Sie einfach meinen Teil der obigen Sammlung hinzu.

Wenn Sie nach weniger Code und vielleicht cooler Benutzeroberfläche suchen. Schauen Sie sich meine GitHub für Progressbar für VBA an 

eine anpassbare ein:

Die DLL ist für MS-Access gedacht, sollte jedoch auf allen VBA-Plattformen mit geringfügigen Änderungen funktionieren. Es gibt auch eine Excel-Datei mit Beispielen. Sie können die vba-Wrapper beliebig erweitern.

Dieses Projekt befindet sich derzeit in der Entwicklung und es werden nicht alle Fehler abgedeckt. Erwarten Sie also einige!

Sie sollten sich um Drittanbieter-DLLs sorgen, und wenn Sie es sind, können Sie vor dem Implementieren der DLL unbedingt vertrauenswürdige Online-Antivirenprogramme verwenden.