Wie kann ich in Excel VBA einen Fortschrittsbalken erstellen?

Ich mache eine Excel-App, die viele Daten aus einer Datenbank aktualisieren muss, also braucht es Zeit. Ich möchte einen Fortschrittsbalken in einem Benutzerformular erstellen, der beim Aktualisieren der Daten angezeigt wird. Der Balken, den ich möchte, ist nur ein kleiner blauer Balken, der sich nach rechts und links bewegt und wiederholt wird, bis das Update abgeschlossen ist. Es wird kein Prozentsatz benötigt.

Ich weiß, ich sollte das benutzen progressbar Steuerelement verwenden, aber ich habe es einige Zeit versucht, kann es aber nicht schaffen.

Mein Problem ist mit der progressbarSteuerung, ich kann den Balken "Fortschritt" nicht sehen. Es wird nur ausgefüllt, wenn das Formular angezeigt wird. Ich benutze eine Schleife und DoEventdas funktioniert nicht. Außerdem möchte ich, dass der Prozess wiederholt und nicht nur einmal ausgeführt wird.

In der Vergangenheit habe ich bei VBA-Projekten ein Beschriftungssteuerelement mit farbigem Hintergrund verwendet und die Größe an den Fortschritt angepasst. Einige Beispiele mit ähnlichen Ansätzen finden Sie unter den folgenden Links:

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/

Hier ist eine, die die Autoshapes von Excel verwendet:

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

Manchmal reicht eine einfache Meldung in der Statusleiste aus:

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 für die Verwendung der Statusleiste als Fortschrittsanzeige.

Mit einigen Unicode-Zeichen können Sie einen Fortschrittsbalken nachahmen. 9608 - 9615 sind die Codes, die ich für die Balken ausprobiert habe. Wählen Sie einfach eine aus, je nachdem, wie viel Platz zwischen den Balken angezeigt werden soll. Sie können die Länge des Balkens festlegen, indem Sie NUM_BARS ändern. Mithilfe einer Klasse 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

Beispielnutzung:

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. Ordnen Sie die Schaltfläche dem Makro "ShowProgress" zu

Erstellen Sie eine UserForm1 mit 2 Schaltflächen, Fortschrittsbalken, Balkenfeld, 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 =============

Ich mag alle hier veröffentlichten Lösungen, habe sie jedoch mithilfe der bedingten Formatierung als prozentuale Datenleiste gelöst.

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

Im Code durchlaufe ich eine Tabelle und mache ein paar Sachen.

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 anständig aus.

Die Größenänderung der Etikettensteuerung 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 Blog-Beitrag, 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 den Fortschrittsbalken aufrufen mit: ModProgress.ShowProgress aufrufen (ActionIndex, TotalActions, Title .....)

Ich hoffe das hilft.

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. Kein Kredit 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

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

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

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 ihn getan und er wurde abgelehnt. Er wurde aufgefordert, eine neue Antwort zu veröffentlichen.

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

Über das progressbarSteuerelement in einem Benutzerformular wird kein Fortschritt angezeigt, wenn Sie das repaintEreignis nicht verwenden . Sie müssen dieses Ereignis innerhalb der Schleife codieren (und natürlich den progressbarWert erhöhen ).

Anwendungsbeispiel:

userFormName.repaint

Ich füge nur meinen Teil der obigen Sammlung hinzu.

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

eine anpassbare:

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

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

Sie sollten sich Sorgen um DLLs von Drittanbietern machen. Wenn dies der Fall ist, können Sie vor der Implementierung der DLL vertrauenswürdige Online-Antivirenprogramme verwenden.

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

1. Verwenden Sie CreateWindowEx()diese Option , um den Fortschrittsbalken 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);

hwndParentSollte auf das übergeordnete Fenster eingestellt sein. 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 FindWindowEx()Funktion relativ einfach sein .

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

Nachdem der Fortschrittsbalken erstellt wurde, müssen Sie Folgendes verwenden, SendMessage()um mit dem Fortschrittsbalken 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 mir nicht sicher, wie praktisch diese Lösung ist, aber sie könnte etwas "offizieller" aussehen als andere hier angegebene Methoden.

Sie können ein Formular hinzufügen und als Form1 benennen, einen Frame als Frame1 sowie als Label1 hinzufügen. Stellen Sie die Breite von Frame1 auf 200 und die Farbe Back auf Blue ein. Fügen Sie den Code in das Modul ein und prüfen Sie, ob er hilft.

    Sub Main()
    Dim i As Integer
    Dim response
    Form1.Show vbModeless
    Form1.Frame1.Width = 0
    For i = 10 To 10000
        With Form1
            .Label1.Caption = Round(i / 100, 0) & "%"
            .Frame1.Width = Round(i / 100, 0) * 2
             DoEvents
        End With
    Next i

    Application.Wait Now + 0.0000075

    Unload Form1

    response = MsgBox("100% Done", vbOKOnly)

    End Sub

Wenn Sie in der Statusleiste anzeigen möchten, können Sie eine andere Methode verwenden, die einfacher ist:

   Sub Main()
   Dim i As Integer
   Dim response
   For i = 10 To 10000
        Application.StatusBar = Round(i / 100, 0) & "%"
   Next i

   Application.Wait Now + 0.0000075

   response = MsgBox("100% Done", vbOKOnly)

   End Sub