# Fortschrittsanzeige bzw. Progress Bar



## deusfalsus (4. Dezember 2007)

Hallo zusammen,

ja, ich habe die Suchfunktion benutzt. Aber die gefundenen Beiträge konnten mit nicht erschöpfend Antwort geben.
Mein Problem ist folgendes:

Im Access-Formular gibt der Nutzer u.a. eine Zeitspanne an, für die bestimmte Informationen geliefert werden sollen. Daher ist die anschließende Wartezeit vorher nicht absehbar.

Es werde dann mehrere komplexe, teils 3-fach geschachtelte Abfrageschleifen durchlaufen.
Je größer der gewählte Zeitraum, desto mehr Elemente im ersten Abfrageergebnis und damit mehr Durchläufe in den inneren Schleifen.

Wie kann ich einen realistischen Fortschrittsbalken anzeigen, der den ungeduldigen Nutzer davon abhält im Glauben an einen Absturz zum "Affengriff" zu greifen?

Hier als Beispiel eine meiner Abfrage-Subroutinen:

```
Private Sub angefausgeb()
Dim db As DAO.Database
Dim rs As DAO.Recordset
Dim rs2 As DAO.Recordset
Dim rs3 As DAO.Recordset
Set db = CurrentDb
 
Dvon = Replace(Format(Me.txt_von, "mm/dd/yyyy"), ".", "/", 1, 7)
tempDbis = Me.txt_bis + 1
Dbis = Replace(Format(tempDbis, "mm/dd/yyyy"), ".", "/", 1, 7)

'alle Anforderungen im Zeitraum werden in die Tabelle 'tbl_Anfo' geschrieben
sql = "SELECT HIMEDX_HIXT530.T530_ANF_DATUM, HIMEDX_HIXT530.T530_ANF_ZEIT, HIMEDX_HIXT530.T530_LAB_NR, HIMEDX_HIXT011.T011_ORG_EH_BEZ, HIMEDX_HIXT530.T530_ZUNAME, HIMEDX_HIXT530.T530_VORNAME, HIMEDX_HIXT530.T530_GEBDATUM, HIMEDX_HIXT530.T530_INDIKATION, HIMEDX_HIXT531.T531_T560_LEIST_CODE, HIMEDX_HIXT531.T531_STK_MENGE " & _
    "INTO tbl_Anfo " & _
    "FROM HIMEDX_HIXT011 INNER JOIN (HIMEDX_HIXT530 INNER JOIN HIMEDX_HIXT531 ON HIMEDX_HIXT530.T530_LAB_NR = HIMEDX_HIXT531.T531_T530_LAB_NR) ON HIMEDX_HIXT011.T011_ORG_EINH = HIMEDX_HIXT530.T530_ANF_ORGEH " & _
    "WHERE (((HIMEDX_HIXT530.T530_ANF_DATUM) Between #" & Dvon & "# And #" & Dbis & "#) " & _
    "AND ((HIMEDX_HIXT531.T531_T560_LEIST_CODE)='" & Me.cbo_Produktart & "') " & _
    "AND ((HIMEDX_HIXT530.T530_STORNO_KZ)='N') AND ((HIMEDX_HIXT531.T531_STORNO_KZ)='N')) " & _
    "ORDER BY HIMEDX_HIXT530.T530_ANF_DATUM, HIMEDX_HIXT530.T530_ANF_ZEIT;"
DoCmd.SetWarnings False
DoCmd.RunSQL (sql)

'Erweitern der Tabelle
sql = "ALTER TABLE tbl_Anfo add gesAusg byte, gesRueck byte;"
DoCmd.RunSQL sql

'Zu jeder Anforderungen können bis zu 50 Ausgaben mit Datum, Konservennummer, Produktcode und Info ob zurückgenommen in die Tabelle eingetragen werden
For i = 1 To 50
    sql = "ALTER TABLE tbl_Anfo add AusgDat" & i & " char(19), KONSERV" & i & " char(7), ProdCode" & i & " char(8), Rueck" & i & " char(1);"
    DoCmd.RunSQL sql
Next i

sql = "SELECT T530_LAB_NR FROM tbl_Anfo;"

Set rs = db.OpenRecordset(sql, dbOpenDynaset)
rs.MoveFirst
While Not rs.EOF
    'alle Ausgaben zur Labornummer holen
    sql = "SELECT HIMEDX_HIXT609.T609_TIMESTAMP, HIMEDX_HIXT607.T607_KONSERV, HIMEDX_HIXT323.T323_KONS_ART " & _
          "FROM HIMEDX_HIXT323 INNER JOIN ((HIMEDX_HIXT618 INNER JOIN HIMEDX_HIXT607 ON HIMEDX_HIXT618.T618_T607_KONSERV = HIMEDX_HIXT607.T607_KONSERV) INNER JOIN HIMEDX_HIXT609 ON HIMEDX_HIXT618.T618_VERWEIS = HIMEDX_HIXT609.T609_AUSGABE) ON HIMEDX_HIXT323.T323_KONS_SER = HIMEDX_HIXT607.T607_T323_KONS_SER " & _
          "WHERE (((HIMEDX_HIXT618.T618_ART)='AG') " & _
          "AND ((HIMEDX_HIXT609.T609_T530_LAB_NR)='" & rs(0) & "') " & _
          "AND ((HIMEDX_HIXT609.T609_STORNO_KZ)='N') " & _
          "AND ((HIMEDX_HIXT618.T618_STORNO_KZ)='N') " & _
          "AND ((HIMEDX_HIXT607.T607_STORNO_KZ)='N'));"
    Set rs2 = db.OpenRecordset(sql, dbOpenDynaset)
    If rs2.RecordCount > 0 Then
        rs2.MoveFirst
        ausgCount = 0
        rueckCount = 0
        While Not rs2.EOF
            ausgCount = ausgCount + 1
            Tag = Left(rs2(0), 2)
            Monat = Right(Left(rs2(0), 5), 2)
            Jahr = Right(Left(rs2(0), 10), 4)
            Zeit = Right(rs2(0), 9)
            ausgabezeitpunkt = Monat & "/" & Tag & "/" & Jahr & Zeit
            'Prüfen, ob nach Ausgabe dieser Konserve noch eine Rücknahme erfolgt ist
            sql = "SELECT HIMEDX_HIXT618.T618_T607_KONSERV " & _
                  "FROM HIMEDX_HIXT607 INNER JOIN HIMEDX_HIXT618 ON HIMEDX_HIXT607.T607_KONSERV = HIMEDX_HIXT618.T618_T607_KONSERV " & _
                  "WHERE (((HIMEDX_HIXT618.T618_T607_KONSERV)= " & rs2(1) & ") " & _
                  "AND ((HIMEDX_HIXT618.T618_DATUM_ZEIT)>#" & ausgabezeitpunkt & "#) " & _
                  "AND ((HIMEDX_HIXT618.T618_ART)='RN'));"
            Set rs3 = db.OpenRecordset(sql, dbOpenDynaset)
            If rs3.RecordCount > 0 Then
                rueck = "j"
                rueckCount = rueckCount + 1
            Else: rueck = "n"
            End If
            rs3.Close
            'Ausgabe zu Anforderung(Labornummer) in tbl_Anfo eintragen
            sql = "UPDATE tbl_Anfo " & _
                  "SET AusgDat" & ausgCount & " = '" & rs2(0) & "', KONSERV" & ausgCount & " = '" & rs2(1) & "', Prodcode" & ausgCount & " = '" & rs2(2) & "', " & _
                "Rueck" & ausgCount & " = '" & rueck & "' " & _
                "WHERE T530_LAB_NR = '" & rs(0) & "';"
            DoCmd.RunSQL sql
            rs2.MoveNext
        Wend
        'Gesamtanzahl der Rueckgaben zur Anforderung(Labornummer) in tbl_Anfo eintragen
        sql = "UPDATE tbl_Anfo " & _
              "SET gesAusg = " & ausgCount & ", gesRueck = " & rueckCount & " " & _
              "WHERE T530_LAB_NR = '" & rs(0) & "';"
        DoCmd.RunSQL sql
    End If
    rs2.Close
    rs.MoveNext
Wend
rs.Close

'Ausgabe in Excel-Tabelle
DoCmd.OutputTo acTable, "tbl_Anfo", "MicrosoftExcelBiff8(*.xls)", "", True, "", 0

DoCmd.SetWarnings True
End Sub
```


----------



## DrSoong (4. Dezember 2007)

Das Problem ist, dass eine ProgressBar in der normalen Art einen definierten Anfang und ein definiertes Ende benötigt. Wie wärs damit, dass du die ProgressBar immer durchlaufen lässt und wieder von vorne startest? So zeigst du, dass das Programm noch läuft, brauchst aber keine genauere Definition für die Bar zaubern (viele Programme zeigen Berechnungen so).


Der Doc!


----------



## Alex F. (5. Dezember 2007)

Alternativ könntest du auch die durchschnittlichen Zeiten deiner Unterroutinen prozentual aufteilen. Problem hierbei ist, das manchmal einige Programmteile (vor allem im Netzwerk) länger dauern und es eine grosse Streuung gibt. Ich finde hierbei die Kombination Progressbar und ein Label, welches die einzelnen "Berechnungschritte" kurz umschreibt für sehr angenehm. 

Ein Balken der nach 100 Prozent wieder auf 0 springt ist da eher deprimierent.

Grüsse bb


----------

