Office: (Office 2016) ProgressBar ActiveX bleibt stehen/stürzt ab

Heatseeker · 12. Mai 2020

Hallo,

Habe ein Formular, in dem ca. 10.000 Datensätze angezeigt werden. Der Fortschritt wird mit einem ProgressBar angezeigt.

Das Problem ist, dass sich der ProgressBar manchmal aufhängt (also einfach stehen bleibt uns nicht weiter läuft!). Manchmal aber auch nicht. Am Ender werden die Daten immer korrekt angezeigt - aber es ist halt irritierend.

Hat jemand da einen Tipp? DoEvents habe ich in der Schleife zum Anzeigen schon versucht - das verlangsamt die Anzeige jedoch extem. Die Alternative über SysCmd und dessen ProgressBar ist zwar eine Alternative - aber darauf will ich nur im Norfall zurückgreifen?

Vielen Dank für Eure Hilfe - bleibt alle gesund!

GlückAuf!

:)

Jimmy_Star · 16. Mai 2020

Stell mal den Code rein damit ich sehen kann wie du den Balken fütterst
Lg Jimmy

Heatseeker · 17. Mai 2020

mit der Schliefe wird ein TreeView gefüllt.
Währenddessen soll der ProgBar laufen...
Es handelt sich um ca. 10.000 Datensätze

Code:

Private Sub Fill_TV_2()

'Fehler-Handling
On Error GoTo Fill_TV_2_ERR

'Variablen deklarieren
Dim objTreeView As MSComctlLib.TreeView
Dim objNode As MSComctlLib.Node
Dim objProgBar As MSComctlLib.ProgressBar
Dim rs As DAO.Recordset
Dim SQL As String
Dim intCOUNT As Long
Dim strMA As String

'SQL-String bilden
SQL = ""
SQL = "SELECT * FROM DBFBIN_PERSAD_D WHERE FA_KTO_NR LIKE 'GP*'"

'RecordSet öffnen
Set rs = CurrentDb.OpenRecordset(SQL)

'RecordSet prüfen
If rs.EOF And rs.BOF Then
rs.Close
Set rs = Nothing
intCOUNT = 0
Exit Sub
Else
rs.MoveLast
intCOUNT = 0
intCOUNT = NZ(rs.RecordCount, 0)
Set objProgBar = Me.ctlProgBar.Object
objProgBar.Min = 0
objProgBar.Max = intCOUNT
intCOUNT = 1
rs.MoveFirst
End If

'Instanzieren des TreeView
Set objTreeView = Me!ctlTreeView.Object

' Redraw für TreeView abschalten
LockControl Me!ctlTreeView, True
With Me!ctlTreeView.Nodes
Do Until .Count = 0
.Remove .Count
Loop
End With

' Redraw für TreeView wieder einschalten
LockControl Me!ctlTreeView, False

'Hauptbaum (1. EBENE) setzen
Set objNode = objTreeView.Nodes.Add(, , "DEB", "DEBITOREN", "Cross")
Set objNode = objTreeView.Nodes.Add(, , "KRE", "KREDITOREN", "Cross")

'Debitoren
'MB KEY = DEBMB
'MB Inland KEY = DEBMBINL
'MB Ausland KEY = DEBMBAUS
'HAIN KEY = DEBHAIN
'HAIN Inland KEY = DEBHAININL
'HAIN Ausland KEY = DEBHAINAUSL
Set objNode = objTreeView.Nodes.Add("DEB", tvwChild, "DEBMB", "Marienborn", "Cross")
Set objNode = objTreeView.Nodes.Add("DEBMB", tvwChild, "DEBMBINL", "Inland", "Cross")
Set objNode = objTreeView.Nodes.Add("DEBMB", tvwChild, "DEBMBAUS", "Ausland", "Cross")
Set objNode = objTreeView.Nodes.Add("DEB", tvwChild, "DEBHAIN", "Hain", "Cross")
Set objNode = objTreeView.Nodes.Add("DEBHAIN", tvwChild, "DEBHAININL", "Inland", "Cross")
Set objNode = objTreeView.Nodes.Add("DEBHAIN", tvwChild, "DEBHAINAUS", "Ausland", "Cross")

'Kreditoren
'MB KEY = DEBMB
'HAIN KEY = DEBHAIN
Set objNode = objTreeView.Nodes.Add("KRE", tvwChild, "KREDINL", "Inland", "Cross")
Set objNode = objTreeView.Nodes.Add("KRE", tvwChild, "KREDAUS", "Ausland", "Cross")

'TreeView füllen
Do Until rs.EOF

strMA = ""
strMA = rs!KTO_NR & " - " & Trim(NZ(rs!Bez_1, "")) _
& Trim(NZ(rs!BEZ_2, "")) _
& Trim(NZ(rs!BEZ_3, ""))

'Debitoren MB INLAND
If rs!KTO_NR >= 100000 And rs!KTO_NR = 200000 And rs!KTO_NR = 300000 And rs!KTO_NR = 400000 And rs!KTO_NR = 700000 And rs!KTO_NR = 800000 And rs!KTO_NR
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

knobbi38 · 17. Mai 2020

Hallo Lars,

ohne Doevents() wird das nicht gehen. Du must dem Syste schon Zeit geben, auf ein Ereignis zum Neuzeichnen reagieren zu können, und dafür muß die Schleife unterbrochen werden.

Ulrich

Heatseeker · 18. Mai 2020

Vielen Dank für die Antwort. Wo setze ich das DoEvents denn am besten in der Schleife? Vor dem RS.moveNext?

knobbi38 · 18. Mai 2020

Hallo Lars,

einfach mal ausprobieren? Das bleibt vollkommen dir überlassen.

Ulrich

CatboyJones · 19. Mai 2020

Ich würde das DoEvents nicht bei jedem Durchlauf ausführen,
sonder z.B. bei jedem 100ten.

Code:

If intCOUNT Mod 100 = 0 Then
DoEvents
End If
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

Das bremst nicht gar so sehr und erfüllt doch seinen Zweck.

Heatseeker · 20. Mai 2020

Danke für den Tipp .. teste das am WE mal und gebe Rückmeldung

Heatseeker · 22. Mai 2020

Hey... hab's gerade getestet! Läuft super!

Vielen Dank nochmal für den Tipp!

Office: (Office 2016) ProgressBar ActiveX bleibt stehen/stürzt ab

ProgressBar ActiveX bleibt stehen/stürzt ab

ProgressBar ActiveX bleibt stehen/stürzt ab

ProgressBar ActiveX bleibt stehen/stürzt ab

ProgressBar ActiveX bleibt stehen/stürzt ab

ProgressBar ActiveX bleibt stehen/stürzt ab - Similar Threads - ProgressBar ActiveX bleibt

Progressbar einbauen

Progressbar / Application-Anzeige

VBA - UserForm ProgressBar --> prozentuales Update funktioniert nicht

„Weitere Steuerelemente“ --> Microsoft ProgressBar nicht vorhanden?

Progressbar/Frotschrittbalken in Tabelle

ProgressBar während des Speicherns anzeigen

Probleme mit Fortschrittsbalken (Progressbar)