Progressbar in Makro einbauen
31.08.2015 10:45:29
Shawn
Ich würde gerne in mein Makro eine Progressbar einbauen.
Weil das Makro bis an die 5min durchläuft und ich so einen anhaltspunkt hätte dass er noch Arbeitet.
Die Progressbar habe ich aus einem Beispiel Kopiert
Sub Progressbar1()
SW = ? 'Bis Makro zu Ende ist
Länge = 0
Schritt = PB1.Label1.Width / SW 'Schrittbreite pro Aktualisierung
For i = 5 To SW
Cells(i, 1) = "Zeile " & i
Cells(i, 1).Interior.ColorIndex = 6
Länge = Länge + Schritt
PB1.Label2.Width = Länge
PB1.Label3.Caption = Format(i / SW, "0 %")
DoEvents
Next
Application.Wait (Now + TimeValue("0:00:2"))
Unload PB1
End Sub
Hier mein Makro worin die Progressbar dann hin müsste
Sub Lieferschein_DECO()
' LieferscheinDECO in Daten Produktion einbuchen
Dim ZeileNr As Long
Dim i As Long
ZeileNr = 19
i = 0
ActiveSheet.Unprotect "shsq"
While Sheets("Vorlage Lieferschein").Range("E" & ZeileNr).Value ""
Sheets("Eingabe Daten Prod. Auftrag").Range("G2").Value = _
Sheets("Vorlage Lieferschein").Range("E" & ZeileNr).Value
Sheets("Eingabe Daten Prod. Auftrag").Range("M2").Value = _
Sheets("Vorlage Lieferschein").Range("C" & ZeileNr).Value
Sheets("Eingabe Daten Prod. Auftrag").Range("K2").Value = _
Sheets("Vorlage Lieferschein").Range("H" & ZeileNr).Value
Sheets("Eingabe Daten Prod. Auftrag").Range("C2").Value = _
Sheets("Vorlage Lieferschein").Range("B" & ZeileNr).Value
Call Einbuchen 'Zeile kopieren und einbuchen
i = i + 1
If i = 8 Then '8 zeilen einbuchen dann wieder auf 0
i = 0
Sheets("Eingabe Daten Prod. Auftrag").Range("AG1").Value = _
Sheets("Eingabe Daten Prod. Auftrag").Range("AG1").Value + 1
End If
ZeileNr = ZeileNr + 1
Wend
Sheets("Eingabe Daten Prod. Auftrag").Range("AG1").FormulaLocal = "=HEUTE()"
If ZeileNr > 19 Then
MsgBox "Positionen auf Lieferschein " & ZeileNr - 19
Else
MsgBox "Bestellerfassung nicht Ausgeführt da auf Lieferschein E19 Leer ist !"
End If
Sheets("Eingabe Daten Prod. Auftrag").Range("C2").ClearContents
Range("G2").ClearContents
Range("K2").ClearContents
Range("M2").ClearContents
Sheets("Vorlage Lieferschein").Delete
Sheets("Eingabe Daten Prod. Auftrag").Range("V2:Y2").ClearContents
Sheets("Eingabe Daten Prod. Auftrag").Unprotect Password:="shsq"
Sheets("Eingabe Daten Prod. Auftrag").EnableAutoFilter = True
Sheets("Eingabe Daten Prod. Auftrag").Protect UserInterfaceOnly:=True, _
Password:="shsq"
End Sub