Access VBA – Fortschrittsbalken per VBA

Problem

Bei längeren VBA Proceduren ist nicht erkennbar, wie weit ein Vorgang abgeschlossen ist.

Lösung

Wir bauen uns ein Formular mit einem „Balken“

In einem neuen Modul erstellen wir folgende kleine Routine

Public Function ProgrBar(lngCurr As Long, lngMax As Long, vProzess As String) '***************************************************************** 
 '*** Maik Ramftel 
 '*** 2010-06-28
 '*** Function erstellt einen Fortschritttsbalken
 '***************************************************************** 
 If DEBUGMODUS = False 
 Then On Error Resume Next 
 End If
 Dim F As Double, P As Integer 
 If lngCurr = 0 And lngMax = 0 Then 
 'Anzeigen DoCmd.OpenForm "FOPROGRESSBAR"
 [Forms]![FOPROGRESSBAR]!rctStatus.Top = [Forms]![FOPROGRESSBAR]!lblStatus.Top
 [Forms]![FOPROGRESSBAR]!rctStatus.Left = [Forms]![FOPROGRESSBAR]!lblStatus.Left 
 [Forms]![FOPROGRESSBAR]!rctStatus.Height = [Forms]![FOPROGRESSBAR]!lblStatus.Height
 [Forms]![FOPROGRESSBAR]!rctStatus.Width = 0 
 [Forms]![FOPROGRESSBAR]!lblStatus.Caption = ""
 [Forms]![FOPROGRESSBAR]!lblStatus.Visible = True 
 [Forms]![FOPROGRESSBAR]!rctStatus.Visible = True [Forms]![FOPROGRESSBAR]![Prozess].Visible = True
 [Forms]![FOPROGRESSBAR]![Prozess].Caption = vProzess
 
 ElseIf lngCurr = -1 And lngMax = -1 Then 
 
 'Ausblenden [Forms]![FOPROGRESSBAR]!lblStatus.Visible = False 
 [Forms]![FOPROGRESSBAR]!rctStatus.Visible = False 
 DoCmd.Close acForm, "FOPROGRESSBAR" 
 
 Else 
 
 'Aktualisieren 
 F = [Forms]![FOPROGRESSBAR]!lblStatus.Width / lngMax 
 [Forms]![FOPROGRESSBAR]!rctStatus.Width = F * lngCurr 
 P = (100 / lngMax) * lngCurr 
 [Forms]![FOPROGRESSBAR]![Prozess].Caption = vProzess 
 [Forms]![FOPROGRESSBAR]!lblStatus.Caption = CStr(P) & "%" 
 End If 
 DoEvents 
 End Function 

Der Aufruf in der Funktion erfolgt dann

Start:

'****Statusanzeige ****** 
 Call ProgrBar(0, 0, vProgressTitel)

Fortschritt:

'****Statusanzeige ****** 
 Call ProgrBar(vZählerP, vAnzahlGesamt, vProgressTitel & " " & vZählerP & "/" & vAnzahlGesamt) 

Ende:

'****Statusanzeige ****** 
 Call ProgrBar(-1, -1, vProgressTitel)