Fortschrittsbalken um einen Loop Code
28.09.2016 13:06:22
Timo
ich versuche seit 2 Tagen eine Progressbar um meinen vorhandenen Loop zu erstellen,
leider ohne Erfolg. Ich hoffe ihr könnt mir helfen!
Ich habe eine frmFortschritt UserForm eingefügt und diesem eine Bar und ein Text Label vergeben - der Code ist recht kurz:
'Legt den Focus auf die erste Kundennummer
Set schreibe = Worksheets("Status 11").Range("A5")
'wechselt in Tr 10
Call transaktionwechsel("10")
'bis die letzte Nummer erreicht ist
Do While Not Format(schreibe.Value) = ""
'gibt die Vertragsnnummer in der Tr 10 und wechselt auf Seite 2
Call wechselVNRKD(schreibe.Value)
Call trSeite("10", 2)
Call isyWriteToIntrasys(1187, 0, False)
'schreibe Kundennamen
Set schreibe = schreibe.Offset(0, 1)
Call lesenInFeld(schreibe, 175, 19)
'gibt die Daten mit "Enter" frei
Call schreiben(1362, "", True)
'springt in die nächste Zeile
Set schreibe = schreibe.Offset(1, -1)
Loop
Unload frmFortschritt
Call trSeite("10", 2)
wird aber solange geloopt, bis die letzte beschriebene Zeile in Spalte A erreicht ist.
Der Code wird über die aktivierung der Userform angestoßen und diese öffnet sich über einen cmdButton.
Hat jemand eine Idee?
Aktuelle Codeversion:
Option Explicit
Public SW As Long
Dim Schritt As Double
Dim Länge As Double
Dim i As Long
Sub Progressbar1()
SW = WorksheetFunction.CountA(Range("A5:A999")) 'Schrittweite festlegen
Länge = 0
Schritt = frmFortschritt.Bar.Width / SW 'Schrittbreite pro Aktualisierung
For i = 5 To SW
'Legt den Focus auf die erste Kundennummer
Set schreibe = Worksheets("Status 11").Range("A5")
'wechselt in Tr 10
Call transaktionwechsel("10")
'bis die letzte Nummer erreicht ist
Do While Not Format(schreibe.Value) = ""
'gibt die Vertragsnnummer in der Tr 10 und wechselt auf Seite 2
Call wechselVNRKD(schreibe.Value)
Call trSeite("10", 2)
Call isyWriteToIntrasys(1187, 0, False)
'schreibe Kundennamen
Set schreibe = schreibe.Offset(0, 1)
Call lesenInFeld(schreibe, 175, 19)
'gibt die Daten mit "Enter" frei
Call schreiben(1362, "", True)
'springt in die nächste Zeile
Set schreibe = schreibe.Offset(1, -1)
Loop
Unload frmFortschritt
Call trSeite("10", 2)
Länge = Länge + Schritt
frmFortschritt.Width = Länge
frmFortschritt.Text.Caption = Format(i / SW, "0 %")
DoEvents
Next
Application.Wait (Now + TimeValue("0:00:2"))
Unload frmFortschritt
End Sub
leider bekomme ich die Fehlermeldung, dass "Set schreibe = Worksheets("Status 11").Range("A5")" - Variable nicht definiertVielen Dank für eure Mühen...
Timo