Office Forum
www.Office-Loesung.de
Access :: Excel :: Outlook :: PowerPoint :: Word :: Office :: Wieder Online ---> provisorisches Office Forum <-
Progressbar - Fortschrittsanzeige selbstgemacht
zurück: Export aller Bilder eines Formulars als Grafikdateien weiter: Barcode für Access (nur mit Access) BC39 Unbeantwortete Beiträge anzeigen
Neues Thema eröffnen   Neue Antwort erstellen     Status: Tutorial Facebook-Likes Diese Seite Freunden empfehlen
Zu Browser-Favoriten hinzufügen
Autor Nachricht
AccessDenied
Excel, Word - fliessend; Access -kauderwelsch


Verfasst am:
25. Jun 2004, 16:04
Rufname:
Wohnort: Stuttgart

Progressbar - Fortschrittsanzeige selbstgemacht - Progressbar - Fortschrittsanzeige selbstgemacht

Nach oben
       

Folgende Funktion zeigt einen Statusbalken an, der langsam von
rot nach grün den Fortschritt einer Berechnung oder einer
Ausführung anzeigt.

Dazu braucht man ein kleines Formular, das ein Textfeld hat (um eine Erläuterung
anzuzeigen) und zwei Bezeichnungsfelder, eines mit rotem Hintergrund und eines mit grünem -
zwei Balken also, die übereinander liegen.

Dieses Formular heisst "Fortschritt".

Um den Fortschrittsbalken verwenden zu können, muss man eine Berechnung
haben, deren Dauer man kennt (z.B. der wievielte Datensatz von Gesamtzahl-Datensätze
gerade bearbeitet wird). Für unabschätzbare Prozesse (wie rekursives Durchackern
von Verzeichnissen, deren Gesamtzahl unbekannt ist) ist ein Fortschrittsbalken
nicht brauchbar.

Hier die Funktion (Plus einer kleinen Zusatzfunktion, die erkennt, ob
das Formular schon geöffnet ist, oder nicht)
Code:
Public Function Gauge(Meldung As String, Anteil As Integer)
'Meldung ist der angezeigte Text
'Anteil ist eine Integerzahl - es gibt 3 Möglichkeiten:
' 1. Anteil= 0    (nur der rote Balken ist sichtbar)
' 2. Anteil ist zwischen 1 und 100 (der grüne Balken überdeckt den roten um
'                                   diesen Anteil)
' 3. Anteil > 100  (schaltet das Formular aus)
    'FortschrittBalken vorbereiten
    ' falls das Formular zum ersten mal aufgerufen wird, wird es geöffnet
    If IstFormOffen("Fortschritt") = False Then
        DoCmd.OpenForm "Fortschritt", acNormal
    End If
    With Forms("Fortschritt")
        ' Titel des Formulars
        .Caption = "Konsistenz-Check"
        ' Sicherstellen, dass die beiden Balken genau übereinander liegen
        .Controls("Grünbalken").Left = .Controls("Rotbalken").Left
        .Controls("Grünbalken").Top = .Controls("Rotbalken").Top
        .Controls("Grünbalken").Height = .Controls("Rotbalken").Height
        'Auszugebender Text ist erstmal leer
        .Controls("Meldung").Caption = ""
    End With
    Select Case Anteil
      Case Is > 100:  ' Formular ausschalten und schliessen
        Forms("Fortschritt").Controls("GrünBalken").Visible = False
        Forms("Fortschritt").Controls("RotBalken").Visible = False
        DoCmd.Close acForm, "Fortschritt"
        Exit Function
      Case 0: ' Initial .... nur der rote Balken ist sichtbar
        Forms("Fortschritt").Controls("RotBalken").Visible = True
        Forms("Fortschritt").Controls("GrünBalken").Visible = False
      Case Else ' Zahl zwischen 1 und 100
        'roter Balken sichtbar
        Forms("Fortschritt").Controls("RotBalken").Visible = True
        'Gesamtlänge von rot
        GRot = Forms("Fortschritt").Controls("RotBalken").Width
        'Gesamtlänge von grün ist Anzahl-Prozent von rot
        GGrün = Int(GRot / 100 * Anteil)
        'Balkenlänge setzen
        Forms("Fortschritt").Controls("GrünBalken").Width = GGrün
        'und  anzeigen
        Forms("Fortschritt").Controls("GrünBalken").Visible = True
    End Select
    'Falls ein neuer Text ausgegeben werden soll, wird die Caption geändert
    'Wenn die Caption bei jedem Aufruf geändert wird,
    'flimmert der Text je nach Rechnerleistung
    If Forms("Fortschritt").Controls("Meldung").Caption <> Meldung Then
        Forms("Fortschritt").Controls("Meldung").Caption = Meldung
    End If
    Forms("Fortschritt").Requery
    Forms("Fortschritt").Repaint
End Function

'Diese Funktion ermittelt, ob das Formular schon geöffnet ist
Public Function IstFormOffen(Formular As String) As Boolean
    IstFormOffen = (SysCmd(acSysCmdGetObjectState, acForm, Formular) <> 0)
End Function
Der Aufruf erfolgt dann z.B. so:
Code:
    Set rstBereich = New ADODB.Recordset
    rstBereich.Open "SELECT * FROM Bereich", CurrentProject.Connection, _
                    adOpenKeyset, adLockOptimistic
    AnzTab = rstBereich.RecordCount
    Do While Not rstBereich.EOF
        Anzahl = Anzahl + 1
        TestGauge = Gauge("Überprüfe alle Bereiche", _
                          Int(Anzahl / AnzTab * 100))
        '....
    Loop
'und die Anzeige ausschalten
   TestGauge = Gauge("", 110) 'Wert über 100 schliesst das Formuar

_________________
cu ANdreas
tocotronicx
Im Profil kannst Du frei den Rang ändern


Verfasst am:
30. Jun 2004, 15:24
Rufname:


AW: Progressbar - Fortschrittsanzeige selbstgemacht - AW: Progressbar - Fortschrittsanzeige selbstgemacht

Nach oben
       

Statusbalken kann man auch noch anders erstellen!!

Initialisierung des Balkens:
Code:
    Dim varreturn As Variant

    varreturn = SysCmd(acSysCmdInitMeter, "Text_in_der_Statuszeile", MaxWert)
Laufen lassen:
Code:
    varreturn = SysCmd(acSysCmdUpdateMeter, aktuellerWert)
aktuellerWert z.B.: aktuellerDS/maxDatensatz oder fixer Wert

Statusbalken Fortschritt berechnet sich dann aus:

aktuellerWert/MaxWert

Ausblenden des Balkens:
Code:
    varreturn = SysCmd(acSysCmdClearStatus)

Viel Spass!! Very Happy
Willi Wipp
Moderator


Verfasst am:
11. Mai 2005, 09:04
Rufname:
Wohnort: Raum Wiesbaden

Re: Progressbar - Fortschrittsanzeige selbstgemacht - Re: Progressbar - Fortschrittsanzeige selbstgemacht

Nach oben
       

Hi Alle,

bitte Nachfragen zu diesem Thema im Forum Access Formulare
beim Thema Pgb - Fortschrittsanzeige selbstgemacht {Nachgefragt} stellen.

Nachtrag: Hier noch eine Beispiel-DB (FortschrittAnzeige_2000.zip)

_________________
Eine kurze Rueckmeldung waere nett
SL Willi Wipp

(Anleitung fuer das Anhaengen von Dateien: Klicke links auf [www], Gaeste muessen sich dafuer anmelden)


Zuletzt bearbeitet von Willi Wipp am 20. Feb 2014, 07:47, insgesamt 3-mal bearbeitet
Bitsqueezer
Office-VBA-Programmierer


Verfasst am:
03. Jul 2007, 13:25
Rufname:

AW: Progressbar - Fortschrittsanzeige selbstgemacht - AW: Progressbar - Fortschrittsanzeige selbstgemacht

Nach oben
       

Hallo zusammen,

basierend auf der Methode, die Access-interne Statusbar zu verwenden, hier eine Funktion dazu, die die Verwaltung der Statusbar im Code übersichtlicher und lesbarer macht. Unten angehängt ist eine Testsub, die die Funktion und Verwendung demonstriert (sorry für die englischen Texte, aber ich programmiere in den meisten Fällen für internationale Umgebungen, kann aber jeder leicht anpassen):
Code:
Option Compare Database
Option Explicit

' Author: Christian Coppes
' Version: 1.0
' Last Update: 03.07.2007
'
' showStatusbar
' Displays the standard-statusbar of access
' Parameters:  strMode = "I": Initialize with a maximum value and an optional
'                             Text
'                        "U": Update the progressbar with a new value
'                        "C": Close the statusbar
'              lngValue = Maximum Value if mode is Init
'                         Actual Value if mode is Update
'                         Standard value: 100
'              bolAutoclose = True: Statusbar will be closed automatically
'                                   if value reaches maximum value
'              strText = Text which should be displayed before the statusbar
'                        Standard value: "Progress: "
'
' Examples:
'
' ?showStatusbar("i",200)           : Initialize statusbar with maximum value
'                                     of 200
' ?showStatusbar("u",10)            : Update statusbar with value 10
' ?showStatusbar("c")               : Close statusbar
' ?showStatusbar("i",,,"My Text: ") : Initialize statusbar with maximum value
'                                     100 and own text
' ?showStatusbar("u",i,True)        : Updates the statusbar with a variable
'                                     value and close it automatically if i
'                                     reaches maximum value
Public Function showStatusbar(strMode As String, _
                              Optional lngValue As Long = 100, _
                              Optional bolAutoclose As Boolean, _
                              Optional strText As String = "Progress: ") _
                             As String
On Error GoTo Fehler
    Dim varReturn As Variant
    Static lngMaxValue As Variant
   
    If strText = "" Then strText = " "
    Select Case UCase(strMode)
      Case "I", "INIT", "START", "OPEN":
        If IsEmpty(lngMaxValue) Then
            lngMaxValue = lngValue
          Else
            showStatusbar = "Init already performed"
            GoTo Ende
        End If
        varReturn = SysCmd(acSysCmdInitMeter, strText, lngMaxValue)
      Case "U", "UPDATE", "MODIFY":
        If IsEmpty(lngMaxValue) Then
            showStatusbar = "Update without init"
            GoTo Ende
        End If
        varReturn = SysCmd(acSysCmdUpdateMeter, lngValue)
        If bolAutoclose = True And lngValue >= lngMaxValue Then
            lngMaxValue = Empty
            varReturn = SysCmd(acSysCmdClearStatus)
        End If
      Case "C", "END", "STOP", "CLOSE":
        If IsEmpty(lngMaxValue) Then
            showStatusbar = "Close without init"
            GoTo Ende
        End If
        varReturn = SysCmd(acSysCmdClearStatus)
        lngMaxValue = Empty
    End Select
    showStatusbar = "OK"
Ende:
    Exit Function
Fehler:
    Select Case Err.Number
      Case 7952:  ' illegal function call
        showStatusbar = "Illegal function call (parameter incorrect)"
        Resume Ende
      Case Else
        showStatusbar = "Error in showStatusbar: " & vbCr & _
                        Err.Description & vbCr & " Number: " & Str(Err.Number)
        MsgBox showStatusbar, vbOKOnly Or vbExclamation, "Error"
        Resume Ende
    End Select
End Function

Public Sub teststatus()
    Dim i As Long
    Dim strOK As String
    Dim sngStart As Single
   
    strOK = showStatusbar("I", 200, , "Teststatus: ")
    If strOK <> "OK" Then
        MsgBox strOK
        Exit Sub
    End If
    For i = 0 To 200
        strOK = showStatusbar("U", i, True)
        If strOK <> "OK" Then
            MsgBox strOK
            Exit Sub
        End If
        sngStart = Timer ' Set start time.
        Do While Timer < sngStart + 0.02
            DoEvents ' Yield to other processes.
        Loop
    Next i
End Sub

Gruß

Christian
Falcon
Einsteiger


Verfasst am:
08. Apr 2008, 11:09
Rufname:
Wohnort: Oberhausen


Fortschrittsanzeige bei Recordsets - Fortschrittsanzeige bei Recordsets

Nach oben
       

Hallo,

Bei sehr zeitintensiven Recordsets die über eine Do-While-Schleife gesteuert werden gibt es eine sehr einfach Möglichkeit einen Fortschrittsbalken zu basteln.

Mit zwei Label-Felder, eins mit dem Style "Vertieft" und das andere normal auf dem Formular wird der Balken dargestellt. Das "vertiefte" Labelfeld dient nur als Begrenzung und das "normale" Labelfeld wird im laufe des Codes "wachsen."
Code:
    Dim Step    As Double
    Dim Akt     As Double
   
    Me!Fortschritt.Width = 0         'größe auf Null, da noch kein Fortschritt
    Me!Fortschritt.Visible = True
    Me!Fortschritt.BackColor = 8454143                            'gelbe Farbe
    Me!Fortschritt.Caption = ""                  'Eingetragenen Text wegnehmen
    'wenn der Recordset (rsT) nicht leer ist, wird If ausgeführt
    If Not rst.EOF Then
        rst.MoveLast
        Step = rst.RecordCount       'zählt die Position des letzten Datensatz
        rst.MoveFirst
        Step = 5630 / Step           'Berechnet die Schrittgröße je Datensatz,
                                                 'wenn Labelfeld 10cm groß ist
        Akt = 0
    End If
    '[...] Code ausgelassen, da irrelevant
    Do While Not rst.EOF    'Schleife die den Recordset durchgeht bis zum Ende
        rsA.AddNew
        rsA!Lieferant = rst!Lieferant     'Beispiel was der Recordset tun kann
        Akt = Akt + Step           'den Aktuellen Wert ein Schritt hoch zählen
        Me!Fortschritt.Width = Akt              'Fortschritsblaken hochsetzten
        DoEvents                        'Die Ausgabe auf dem Formular auslösen
    Loop
    Me!Fortschritt.Width = 5630             'Fortschrittsbalken auf max. größe
    Me!Fortschritt.BackColor = 65280                                     'grün
    Me!Fortschritt.Caption = "Fertig"
Ich hoffe das kann noch anderen Helfen

MfG
Falcon
Lejf Diecks
Gast


Verfasst am:
28. Feb 2009, 14:22
Rufname:

AW: Progressbar - Fortschrittsanzeige selbstgemacht - AW: Progressbar - Fortschrittsanzeige selbstgemacht

Nach oben
       Version: Office 2003

Hab den Ansatz von Tocotronicx nochmal in ein Klassenmodul gegossen, bei dem man zur Laufzeit auch den Text zur Statusbar ändern kann, wenn man will. Zusätzlich löscht ein Destruktor beim Beenden die Statusleiste:
Code:
' Modul, um die eingebaute Statusbar in Anzeigefenster von Access zu steuern
' Autor: Lejf Diecks (2009/02/27)
Option Compare Database
Option Explicit

Private t As String
Private mv As Long

Private Sub Class_Initialize()
' Konstruktor: Alte Progressbar löschen (wenn vorhanden)
    Me.clear
End Sub

Public Function init(maxVal As Long, Text As String)
' Init: Progressbar mit Text aufbauen, Text setzen
    t = Text
    mv = maxVal
    SysCmd acSysCmdInitMeter, t, maxVal
End Function

Public Function update(newVal As Long, Optional Text As String = "")
' Update: Progressbar updaten, ggf. mit neuem Text
'         (für Anzeige wie "Status (10 von 200)" o. ä.)
    If (Text <> "") Then
        t = Text
        SysCmd acSysCmdInitMeter, t, mv
        SysCmd acSysCmdUpdateMeter, newVal
      Else
        SysCmd acSysCmdUpdateMeter, newVal
    End If
End Function

Public Function clear()
' Clear: Progressbar wieder löschen
    SysCmd acSysCmdClearStatus
End Function

Private Sub Class_Terminate()
' Destruktor: Progressbar wieder löschen
    Me.clear
End Sub
Bitsqueezer
Office-VBA-Programmierer


Verfasst am:
04. Sep 2010, 13:26
Rufname:

AW: Progressbar - Fortschrittsanzeige selbstgemacht - AW: Progressbar - Fortschrittsanzeige selbstgemacht

Nach oben
       Version: Office 2003

Hallo,

hier mal wieder eine neue Version der Progressbar, diesmal unter Verwendung der ActiveX-Progressbar aus der Common Control Library.

Das Modul kann nach Belieben verwendet werden, ist bereits alltagstauglich geprüft und funktioniert auch in der Access Runtime.

Viel Spaß beim Ausprobieren...

Christian



ProgressBar.zip
 Beschreibung:
Progressbar als ActiveX aus der Common Controls Library in einem Formular mit Stop-Button.

Download
 Dateiname:  ProgressBar.zip
 Dateigröße:  25.22 KB
 Heruntergeladen:  2057 mal

nitro_storm
VB / VBA / .NET Programmierer


Verfasst am:
03. Jul 2013, 12:24
Rufname: Nitro
Wohnort: FFM

AW: Progressbar - Fortschrittsanzeige selbstgemacht - AW: Progressbar - Fortschrittsanzeige selbstgemacht

Nach oben
       

Hallo,

ich hab das Beispiel von Bitsqueezer mal ein wenig angepasst, damit man es einfacher verwenden kann.

_________________
Gruss
Nitro

-=Schon die Piste, geh FREERIDEN=-



ProgressBar.zip
 Beschreibung:

Download
 Dateiname:  ProgressBar.zip
 Dateigröße:  66.79 KB
 Heruntergeladen:  391 mal

alternativer nickname
Gast


Verfasst am:
31. Okt 2013, 14:02
Rufname:


AW: Progressbar - Fortschrittsanzeige selbstgemacht - AW: Progressbar - Fortschrittsanzeige selbstgemacht

Nach oben
       Version: Office 2003

Danke! Der Code hat mir eine Menge Zeit gespart.
Kleine Änderung um die MaxSteps zu erweitern wenn nach der initialisierung weitere Steps hinzu kommen.

Aufrufbeispiel:
Code:
    UpdateProgress "Check database connection...", addToMax:=CurrentDb.TableDefs.Count
Geänderter UpdateProgress:
showstatusval auf optional mit standard false und ein Optional addToMax As Long = 0
Code:
Public Function UpdateProgress(sStatusText As String _
                    , Optional showstatusval As Boolean = False _
                    , Optional newVal As Long = 0 _
                    , Optional addToMax As Long = 0) As Boolean
    lVal = lVal + 1
    If newVal > 0 Then lVal = newVal
    With objProgressbar
        If addToMax > 0 Then .pgbMax = .pgbMax + addToMax
        .pgbValue = lVal
        If Len(sStatusText) Then _
           .txtMessage = sStatusText & IIf(showstatusval _
                                         , vbCrLf & lVal & " von " & .pgbMax _
                                         , "")
        DoEvents
        UpdateProgress = .pgbStop
    End With
End Function

Danke und Grüße
odi
Neues Thema eröffnen   Neue Antwort erstellen Alle Zeiten sind
GMT + 1 Stunde

Diese Seite Freunden empfehlen

Seite 1 von 1
Gehe zu:  
Du kannst Beiträge in dieses Forum schreiben.
Du kannst auf Beiträge in diesem Forum antworten.
Du kannst deine Beiträge in diesem Forum nicht bearbeiten.
Du kannst deine Beiträge in diesem Forum nicht löschen.
Du kannst an Umfragen in diesem Forum nicht mitmachen.
Du kannst Dateien in diesem Forum nicht posten
Du kannst Dateien in diesem Forum herunterladen

Verwandte Themen
Forum / Themen   Antworten   Autor   Aufrufe   Letzter Beitrag 
Keine neuen Beiträge Access Programmierung / VBA: progressbar erstellen 12 leuchtkugel 157 29. März 2014, 06:43
Willi Wipp progressbar erstellen
Keine neuen Beiträge Access Programmierung / VBA: Progressbar bei Tabellenerstellungsabfrage 5 etienne 334 14. Jun 2013, 23:30
Bitsqueezer Progressbar bei Tabellenerstellungsabfrage
Keine neuen Beiträge Access Formulare: Progressbar anzeigen, während Abfrage läuft(Aufruf Formular) 1 AntonBC 376 05. Okt 2012, 15:33
steffen0815 Progressbar anzeigen, während Abfrage läuft(Aufruf Formular)
Keine neuen Beiträge Access Formulare: Progressbar ansprechen 3 Matze980237462345 485 20. Sep 2012, 12:10
Bitsqueezer Progressbar ansprechen
Keine neuen Beiträge Access Formulare: Text immer markiert bei Fortschrittsanzeige 2 Fornax 300 01. März 2012, 11:58
Fornax Text immer markiert bei Fortschrittsanzeige
Keine neuen Beiträge Access Programmierung / VBA: Progessbar (Fortschrittsanzeige) bei Import aus TXT Datei 4 Werwolfli 994 18. Nov 2010, 12:31
Gast Progessbar (Fortschrittsanzeige) bei Import aus TXT Datei
Keine neuen Beiträge Access Programmierung / VBA: BE/FE selbstgemacht - Performance & Fehlermeldung 3 rosenfem 798 08. Okt 2010, 21:17
MissPh! BE/FE selbstgemacht - Performance & Fehlermeldung
Keine neuen Beiträge Access Programmierung / VBA: Progressbar - multithreading in access 4 VBAY 3450 17. Feb 2010, 20:03
Bitsqueezer Progressbar - multithreading in access
Keine neuen Beiträge Access Programmierung / VBA: Fortschrittsanzeige während der Laufzeit 3 wm_andi 2421 03. Nov 2009, 18:30
wm_andi Fortschrittsanzeige während der Laufzeit
Keine neuen Beiträge Access Programmierung / VBA: Fortschrittsanzeige 4 Z.Mart 1085 23. Okt 2008, 16:18
Z.Mart Fortschrittsanzeige
Keine neuen Beiträge Access Programmierung / VBA: Fehler bei Fortschrittsanzeige 7 derFuxx 877 08. Okt 2008, 13:47
derFuxx Fehler bei Fortschrittsanzeige
Keine neuen Beiträge Access Programmierung / VBA: Access Progressbar anzapfen 4 access0815 4856 01. Jun 2007, 13:37
Gast Access Progressbar anzapfen
 

----> Diese Seite Freunden empfehlen <------ Impressum - Besuchen Sie auch: Microsoft Excel-Formeln