Fortschrittsbalken in VBA Excel

Manchmal ist eine einfache Meldung in der status bar ist genug:

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

InformationsquelleAutor eykanal

============== This code goes in Module1 ============

Sub ShowProgress()
    UserForm1.Show
End Sub

============== Module1 Code Block End =============

Erstellen Sie eine Schaltfläche in einem Arbeitsblatt; Karte-Knopf, um "ShowProgress" makro

Erstellen Sie eine UserForm1 mit 2 Tasten, Fortschrittsbalken, bar-box, 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 =============

InformationsquelleAutor John Harris

Liebe ich alle Lösungen hier gepostet, aber ich löste dies durch Bedingte Formatierung als Prozentwert-basierte Daten-Bar.

Diese wird angewendet, um eine Reihe von Zellen, wie unten gezeigt. Die Zellen sind von 0% und 100% sind normalerweise ausgeblendet, weil Sie nur da, um dem "ScanProgress" benannten Bereich (Links -) Kontext.

In der code, den ich bin die Schleife durch eine Tabelle dabei einige 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

Minimalen code, sieht anständig aus.

InformationsquelleAutor Lucretius

Hallo modifizierte version von einem anderen Beitrag 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 nicht Bearbeiten, der post ist, ich habe und es abgelehnt, mir wurde gesagt die post eine neue Antwort.

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

InformationsquelleAutor ozmike

Gab es viele andere tolle Beiträge, aber ich möchte sagen, theoretisch sollten Sie in der Lage sein zu erstellen REAL progress bar control:

1. Verwenden CreateWindowEx() zu erstellen, den Fortschritt-bar

Einem 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. Dafür könnte man die status bar, oder eine benutzerdefinierte form! Hier ist der window-Struktur von Excel-gefunden von Spy++:

Diese sollten daher relativ einfach, mit FindWindowEx() Funktion.

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

Nachdem die Fortschrittsanzeige erstellt wurde, müssen Sie SendMessage() um die Interaktion mit der Statusanzeige:

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 es könnte etwas mehr "offizielle" als andere Methoden hier angegeben werden.

InformationsquelleAutor Sancarn

Schön, dialog, progressbar-form, die ich suchte.
progressbar aus alainbryden

sehr einfach zu bedienen und sieht nett aus.

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

hier ist gute alternative, Klasse.

InformationsquelleAutor ya_dimon